master..82b3bd0 · elk · git.iko.soy

git.iko.soy/elk

on 82b3bd0 help sign in

.github/CONTRIBUTING.md+20−18

since splitsnapshots

unifiedsplit

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

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

5possible.

7+## Licensing

8−## Expectations

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

9−

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

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

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

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

13−

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

15−

17## Style Guide

12## Style Guide

@@ -22,20 +17,27 @@ Finally, please be patient with the core team. They are trying their best with l

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

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

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

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

25−

26## Branches

20## Branches

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

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

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

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

30−should target this branch!

24+ should target this branch!

31−

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

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.

35−## Licensing

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

36−

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

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

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

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

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

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

36+features.

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.

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

.github/PULL_REQUEST_TEMPLATE.mddeleted−18

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

1−

2−**Quick Summary:** ???

3−

4−

5−## SSCCE

6−

7−```elm

8−

9−```

10−

11−- **Elm:** ???

12−- **Browser:** ???

13−- **Operating System:** ???

14−

15−

16−## Additional Details

17−

18−???

.github/workflows/set-issue-expectations.ymldeleted−21

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

1−name: Set Issue Expectations

2−on:

3− issues:

4− types: [opened]

5−jobs:

6− comment-on-issue:

7− name: Comment On Issue

8− runs-on: ubuntu-latest

9− steps:

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

11− env:

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

13− with:

14− args: |

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

16−

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

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

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

20−

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

.github/workflows/set-pull-expectations.ymldeleted−19

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

1−on:

2− pull_request_target:

3− types: [opened]

4−

5−jobs:

6− comment-on-pull:

7− name: Comment On Pull

8− runs-on: ubuntu-latest

9− steps:

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

11− with:

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

13− script: |

14− github.issues.createComment({

15− issue_number: context.issue.number,

16− owner: context.repo.owner,

17− repo: context.repo.repo,

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

19− })

.gitignore−1

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

5cabal.sandbox.config

6.DS_Store

7*~

8−travis.log

.travis.ymldeleted−28

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

1−language: minimal

2−services: docker

3−

4−env:

5− global:

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

7−

8−before_install:

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

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

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

12−

13−deploy:

14− provider: releases

15− api_key:

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

17− file: $LINUX_ARCHIVE

18− skip_cleanup: true

19− on:

20− branch: master

21− tags: true

22−

23−notifications:

24− email:

25− recipients:

26− - rlefevre@dmy.fr

27− on_success: change

28− on_failure: change

ContributorAgreement.pdfnew file

Binary file not shown.

LICENSE+25−6

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

3−Redistribution and use in source and binary forms, with or without 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.

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

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

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

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

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

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

11+ * Redistributions in binary form must reproduce the above

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

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

14+ with the distribution.

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

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

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

18+ from this software without specific prior written permission.

19+

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

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

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

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

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

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

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

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

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

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

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

README.md+5−10

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

1−# Elm

1+# The Elm Compiler

3−A delightful language for reliable webapps.

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

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−

10## Install

6## Install

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

8+Follow [these instructions][installer]!

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

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

16−

18## Help

13## Help

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

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

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

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

builder/src/BackgroundWriter.hsdeleted−42

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

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+294−531

@@ -1,16 +1,12 @@

1{-# OPTIONS_GHC -Wno-unused-do-bind #-}

2−{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings #-}

2+{-# LANGUAGE BangPatterns, OverloadedStrings #-}

3module Build

4 ( fromExposed

5− , fromPaths

5+ , fromMains

6− , fromRepl

7 , Artifacts(..)

6 , Artifacts(..)

8− , Root(..)

7+ , Main(..)

9 , Module(..)

8 , Module(..)

10 , CachedInterface(..)

9 , CachedInterface(..)

11− , ReplArtifacts(..)

12− , DocsGoal(..)

13− , getRootNames

14 )

10 )

15 where

11 where

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

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

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

21import qualified Data.ByteString as B

17import qualified Data.ByteString as B

22import qualified Data.Char as Char

18import qualified Data.Char as Char

19+import qualified Data.Either as Either

23import qualified Data.Graph as Graph

20import qualified Data.Graph as Graph

24import qualified Data.List as List

21import qualified Data.List as List

25import qualified Data.Map.Utils as Map

22import qualified Data.Map.Utils as Map

@@ -34,27 +31,22 @@ import qualified System.Directory as Dir

34import qualified System.FilePath as FP

31import qualified System.FilePath as FP

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

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

37−import qualified AST.Canonical as Can

38import qualified AST.Source as Src

34import qualified AST.Source as Src

39import qualified AST.Optimized as Opt

35import qualified AST.Optimized as Opt

40import qualified Compile

36import qualified Compile

41import qualified Elm.Details as Details

37import qualified Elm.Details as Details

42−import qualified Elm.Docs as Docs

43import qualified Elm.Interface as I

38import qualified Elm.Interface as I

44import qualified Elm.ModuleName as ModuleName

39import qualified Elm.ModuleName as ModuleName

45import qualified Elm.Outline as Outline

40import qualified Elm.Outline as Outline

46import qualified Elm.Package as Pkg

41import qualified Elm.Package as Pkg

47import qualified File

42import qualified File

48−import qualified Json.Encode as E

49import qualified Parse.Module as Parse

43import qualified Parse.Module as Parse

50import qualified Reporting

44import qualified Reporting

51import qualified Reporting.Annotation as A

45import qualified Reporting.Annotation as A

52import qualified Reporting.Error as Error

46import qualified Reporting.Error as Error

53−import qualified Reporting.Error.Docs as EDocs

54import qualified Reporting.Error.Syntax as Syntax

47import qualified Reporting.Error.Syntax as Syntax

55import qualified Reporting.Error.Import as Import

48import qualified Reporting.Error.Import as Import

56import qualified Reporting.Exit as Exit

49import qualified Reporting.Exit as Exit

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

58import qualified Stuff

50import qualified Stuff

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

66 Env

58 Env

67 { _key :: Reporting.BKey

59 { _key :: Reporting.BKey

68 , _root :: FilePath

60 , _root :: FilePath

69− , _project :: Parse.ProjectType

61+ , _pkg :: Pkg.Name

70− , _srcDirs :: [AbsoluteSrcDir]

62+ , _srcDirs :: [FilePath]

71− , _buildID :: Details.BuildID

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

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

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

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

74 }

65 }

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

68+makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> Env

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

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

79 case validOutline of

70 case validOutline of

80− Details.ValidApp givenSrcDirs ->

71+ Details.ValidApp (Outline.AppOutline _ srcDirs _ _ _ _) ->

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

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

72+ Env key root Pkg.dummyName (NE.toList srcDirs) locals foreigns

84− Details.ValidPkg pkg _ _ ->

74+ Details.ValidPkg (Outline.PkgOutline pkg _ _ _ _ _ _ _) _ ->

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

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

75+ Env key root pkg ["src"] locals foreigns

87−

88−

89−

90−-- SOURCE DIRECTORY

91−

92−

93−newtype AbsoluteSrcDir =

94− AbsoluteSrcDir FilePath

95−

96−

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

98−toAbsoluteSrcDir root srcDir =

99− AbsoluteSrcDir <$> Dir.canonicalizePath

100− (

101− case srcDir of

102− Outline.AbsoluteSrcDir dir -> dir

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

104− )

105−

106−

107−addRelative :: AbsoluteSrcDir -> FilePath -> FilePath

108−addRelative (AbsoluteSrcDir srcDir) path =

109− srcDir </> path

110

111

112

113-- FORK

79-- FORK

114

115

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

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

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

121fork work =

83fork work =

122 do mvar <- newEmptyMVar

84 do mvar <- newEmptyMVar

@@ -134,22 +96,21 @@ forkWithKey func dict =

134-- FROM EXPOSED

96-- FROM EXPOSED

135

136

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

99+fromExposed :: Reporting.Style -> FilePath -> Details.Details -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem ())

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

100+fromExposed style root details exposed@(NE.List e es) =

139 Reporting.trackBuild style $ \key ->

101 Reporting.trackBuild style $ \key ->

140− do env <- makeEnv key root details

102+ do let env = makeEnv key root details

141 dmvar <- Details.loadInterfaces root details

103 dmvar <- Details.loadInterfaces root details

142

104

143 -- crawl

105 -- crawl

144 mvar <- newEmptyMVar

106 mvar <- newEmptyMVar

145− let docsNeed = toDocsNeed docsGoal

146− roots <- Map.fromKeysA (fork . crawlModule env mvar docsNeed) (e:es)

107+ roots <- Map.fromKeysA (fork . crawlModule env mvar) (e:es)

147 putMVar mvar roots

108 putMVar mvar roots

148 mapM_ readMVar roots

109 mapM_ readMVar roots

149 statuses <- traverse readMVar =<< readMVar mvar

110 statuses <- traverse readMVar =<< readMVar mvar

150

111

151 -- compile

112 -- compile

152− midpoint <- checkMidpoint dmvar statuses

113+ midpoint <- checkExposedMidpoint dmvar statuses

153 case midpoint of

114 case midpoint of

154 Left problem ->

115 Left problem ->

155 return (Left (Exit.BuildProjectProblem problem))

116 return (Left (Exit.BuildProjectProblem problem))

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

160 putMVar rmvar resultMVars

121 putMVar rmvar resultMVars

161 results <- traverse readMVar resultMVars

122 results <- traverse readMVar resultMVars

162 writeDetails root details results

123 writeDetails root details results

163− finalizeExposed root docsGoal exposed results

124+ return (detectExposedProblems exposed results)

164

125

165

126

166

127

167−-- FROM PATHS

128+-- FROM MAINS

168

129

169

130

170data Artifacts =

131data Artifacts =

171 Artifacts

132 Artifacts

172 { _name :: Pkg.Name

133 { _name :: Pkg.Name

173 , _deps :: Dependencies

134 , _deps :: Dependencies

174− , _roots :: NE.List Root

135+ , _mains :: NE.List Main

175 , _modules :: [Module]

136 , _modules :: [Module]

176 }

137 }

177

138

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

185 Map.Map ModuleName.Canonical I.DependencyInterface

146 Map.Map ModuleName.Canonical I.DependencyInterface

186

147

187

148

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

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

189−fromPaths style root details paths =

150+fromMains style root details paths =

190 Reporting.trackBuild style $ \key ->

151 Reporting.trackBuild style $ \key ->

191− do env <- makeEnv key root details

152+ do let env = makeEnv key root details

192

153

193− elroots <- findRoots env paths

154+ elmains <- findMains env paths

194− case elroots of

155+ case elmains of

195 Left problem ->

156 Left problem ->

196 return (Left (Exit.BuildProjectProblem problem))

157 return (Left (Exit.BuildProjectProblem problem))

197

158

198− Right lroots ->

159+ Right lmains ->

199 do -- crawl

160 do -- crawl

200 dmvar <- Details.loadInterfaces root details

161 dmvar <- Details.loadInterfaces root details

201 smvar <- newMVar Map.empty

162 smvar <- newMVar Map.empty

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

163+ smainMVars <- traverse (fork . crawlMain env smvar) lmains

203− sroots <- traverse readMVar srootMVars

164+ smains <- traverse readMVar smainMVars

204 statuses <- traverse readMVar =<< readMVar smvar

165 statuses <- traverse readMVar =<< readMVar smvar

205

166

206− midpoint <- checkMidpointAndRoots dmvar statuses sroots

167+ midpoint <- checkMainsMidpoint dmvar statuses smains

207 case midpoint of

168 case midpoint of

208 Left problem ->

169 Left problem ->

209 return (Left (Exit.BuildProjectProblem problem))

170 return (Left (Exit.BuildProjectProblem problem))

@@ -213,26 +174,10 @@ fromPaths style root details paths =

213 rmvar <- newEmptyMVar

174 rmvar <- newEmptyMVar

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

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

215 putMVar rmvar resultsMVars

176 putMVar rmvar resultsMVars

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

177+ rmainMVars <- traverse (fork . checkMain env resultsMVars) smains

217 results <- traverse readMVar resultsMVars

178 results <- traverse readMVar resultsMVars

218 writeDetails root details results

179 writeDetails root details results

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

180+ toArtifacts env foreigns results <$> traverse readMVar rmainMVars

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

236

181

237

182

238

183

@@ -245,7 +190,7 @@ type StatusDict =

245

190

246data Status

191data Status

247 = SCached Details.Local

192 = SCached Details.Local

248− | SChanged Details.Local B.ByteString Src.Module DocsNeed

193+ | SChanged Details.Local B.ByteString Src.Module

249 | SBadImport Import.Problem

194 | SBadImport Import.Problem

250 | SBadSyntax FilePath File.Time B.ByteString Syntax.Error

195 | SBadSyntax FilePath File.Time B.ByteString Syntax.Error

251 | SForeign Pkg.Name

196 | SForeign Pkg.Name

@@ -262,14 +207,15 @@ crawlDeps env mvar deps blockedValue =

262 mapM_ readMVar statuses

207 mapM_ readMVar statuses

263 return blockedValue

208 return blockedValue

264 where

209 where

265− crawlNew name () = fork (crawlModule env mvar (DocsNeed False) name)

210+ crawlNew name () = fork (crawlModule env mvar name)

266

211

267

212

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

213+crawlModule :: Env -> MVar StatusDict -> ModuleName.Raw -> IO Status

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

214+crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar name =

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

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

216+ let inRoot path = File.exists (root </> path)

271

217

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

218+ paths <- filterM inRoot (map (</> fileName) srcDirs)

273

219

274 case paths of

220 case paths of

275 [path] ->

221 [path] ->

@@ -278,18 +224,21 @@ crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar do

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

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

279

225

280 Nothing ->

226 Nothing ->

281− do newTime <- File.getTime path

282− case Map.lookup name locals of

227+ case Map.lookup name locals of

283− Nothing ->

228+ Nothing ->

284− crawlFile env mvar docsNeed name path newTime buildID

229+ crawlFile env mvar name path

285

230

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

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

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

232+ if path /= oldPath

233+ then crawlFile env mvar name path

234+ else

235+ do newTime <- File.getTime path

236+ if oldTime < newTime

288− then crawlFile env mvar docsNeed name path newTime lastChange

237+ then crawlFile env mvar name path

289− else crawlDeps env mvar deps (SCached local)

238+ else crawlDeps env mvar deps (SCached local)

290

239

291 p1:p2:ps ->

240 p1:p2:ps ->

292− return $ SBadImport $ Import.AmbiguousLocal (FP.makeRelative root p1) (FP.makeRelative root p2) (map (FP.makeRelative root) ps)

241+ return $ SBadImport $ Import.AmbiguousLocal p1 p2 ps

293

242

294 [] ->

243 [] ->

295 case Map.lookup name foreigns of

244 case Map.lookup name foreigns of

@@ -302,18 +251,19 @@ crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar do

302 return $ SBadImport $ Import.AmbiguousForeign dep d ds

251 return $ SBadImport $ Import.AmbiguousForeign dep d ds

303

252

304 Nothing ->

253 Nothing ->

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

254+ if Name.isKernel name && Pkg.isKernel pkg then

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

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

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

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

308 else

257 else

309 return $ SBadImport Import.NotFound

258 return $ SBadImport Import.NotFound

310

259

311

260

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

261+crawlFile :: Env -> MVar StatusDict -> ModuleName.Raw -> FilePath -> IO Status

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

262+crawlFile env@(Env _ root pkg _ _ _) mvar expectedName path =

263+ do time <- File.getTime path

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

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

315

265

316− case Parse.fromByteString projectType source of

266+ case Parse.fromByteString pkg source of

317 Left err ->

267 Left err ->

318 return $ SBadSyntax path time source err

268 return $ SBadSyntax path time source err

319

269

@@ -326,16 +276,16 @@ crawlFile env@(Env _ root projectType _ buildID _ _) mvar docsNeed expectedName

326 if expectedName == actualName then

276 if expectedName == actualName then

327 let

277 let

328 deps = map Src.getImportName imports

278 deps = map Src.getImportName imports

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

279+ local = Details.Local path time deps (any isMain values)

330 in

280 in

331− crawlDeps env mvar deps (SChanged local source modul docsNeed)

281+ crawlDeps env mvar deps (SChanged local source modul)

332 else

282 else

333 return $ SBadSyntax path time source (Syntax.ModuleNameMismatch expectedName name)

283 return $ SBadSyntax path time source (Syntax.ModuleNameMismatch expectedName name)

334

284

335

285

336isMain :: A.Located Src.Value -> Bool

286isMain :: A.Located Src.Value -> Bool

337isMain (A.At _ (Src.Value (A.At _ name) _ _ _)) =

287isMain (A.At _ (Src.Value (A.At _ name) _ _ _)) =

338− name == Name._main

288+ name == Name.main

339

289

340

290

341

291

@@ -347,9 +297,9 @@ type ResultDict =

347

297

348

298

349data Result

299data Result

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

300+ = RNew Details.Local I.Interface Opt.LocalGraph

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

301+ | RSame Details.Local I.Interface Opt.LocalGraph

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

302+ | RCached Bool (MVar CachedInterface)

353 | RNotFound Import.Problem

303 | RNotFound Import.Problem

354 | RProblem Error.Module

304 | RProblem Error.Module

355 | RBlocked

305 | RBlocked

@@ -364,23 +314,23 @@ data CachedInterface

364

314

365

315

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

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

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

317+checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =

368 case status of

318 case status of

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

319+ SCached local@(Details.Local path time deps hasMain) ->

370 do results <- readMVar resultsMVar

320 do results <- readMVar resultsMVar

371− depsStatus <- checkDeps root results deps lastCompile

321+ depsStatus <- checkDeps root results deps

372 case depsStatus of

322 case depsStatus of

373 DepsChange ifaces ->

323 DepsChange ifaces ->

374 do source <- File.readUtf8 path

324 do source <- File.readUtf8 path

375− case Parse.fromByteString projectType source of

325+ case Parse.fromByteString pkg source of

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

326+ Right modul -> compile env local source ifaces modul

377 Left err ->

327 Left err ->

378 return $ RProblem $

328 return $ RProblem $

379 Error.Module name path time source (Error.BadSyntax err)

329 Error.Module name path time source (Error.BadSyntax err)

380

330

381 DepsSame _ _ ->

331 DepsSame _ _ ->

382 do mvar <- newMVar Unneeded

332 do mvar <- newMVar Unneeded

383− return (RCached hasMain lastChange mvar)

333+ return (RCached hasMain mvar)

384

334

385 DepsBlock ->

335 DepsBlock ->

386 return RBlocked

336 return RBlocked

@@ -388,25 +338,29 @@ checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name statu

388 DepsNotFound problems ->

338 DepsNotFound problems ->

389 do source <- File.readUtf8 path

339 do source <- File.readUtf8 path

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

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

391− case Parse.fromByteString projectType source of

341+ case Parse.fromByteString pkg source of

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

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

393 Error.BadImports (toImportErrors env results imports problems)

343 Error.BadImports (toImportErrors env results imports problems)

394

344

395 Left err ->

345 Left err ->

396 Error.BadSyntax err

346 Error.BadSyntax err

397

347

398− SChanged local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _) docsNeed ->

348+ SChanged local@(Details.Local path time deps _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) ->

399 do results <- readMVar resultsMVar

349 do results <- readMVar resultsMVar

400− depsStatus <- checkDeps root results deps lastCompile

350+ depsStatus <- checkDeps root results deps

401 case depsStatus of

351 case depsStatus of

402 DepsChange ifaces ->

352 DepsChange ifaces ->

403− compile env docsNeed local source ifaces modul

353+ compile env local source ifaces modul

404

354

405 DepsSame same cached ->

355 DepsSame same cached ->

406− do maybeLoaded <- loadInterfaces root same cached

356+ do maybeLoaded <- checkCachedInterfaces root cached

407 case maybeLoaded of

357 case maybeLoaded of

358+ Nothing ->

408− Nothing -> return RBlocked

359+ return RBlocked

360+

361+ Just loaded ->

362+ do let ifaces = Map.union loaded (Map.fromList same)

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

363+ compile env local source ifaces modul

410

364

411 DepsBlock ->

365 DepsBlock ->

412 return RBlocked

366 return RBlocked

@@ -425,7 +379,7 @@ checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name statu

425 SForeign home ->

379 SForeign home ->

426 case foreigns ! ModuleName.Canonical home name of

380 case foreigns ! ModuleName.Canonical home name of

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

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

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

382+ I.Private _ _ _ -> error "loading private interface in Build"

429

383

430 SKernel ->

384 SKernel ->

431 return RKernel

385 return RKernel

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

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

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

443

397

444

398

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

399+checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> IO DepsStatus

446−checkDeps root results deps lastCompile =

400+checkDeps root results deps =

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

401+ checkDepsHelp root results deps [] [] [] [] False

448

402

449

403

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

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

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

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

452

406

453

407

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

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

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

409+checkDepsHelp root results deps new same cached importProblems isBlocked =

456 case deps of

410 case deps of

457 dep:otherDeps ->

411 dep:otherDeps ->

458 do result <- readMVar (results ! dep)

412 do result <- readMVar (results ! dep)

459 case result of

413 case result of

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

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

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

462−

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

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

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

465−

466− RCached _ lastChange mvar ->

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

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

468−

469− RNotFound prob ->

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

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

471−

472− RProblem _ ->

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

418+ RProblem _ -> checkDepsHelp root results otherDeps new same cached importProblems True

474−

475− RBlocked ->

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

419+ RBlocked -> checkDepsHelp root results otherDeps new same cached importProblems True

477−

478− RForeign iface ->

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

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

480−

481− RKernel ->

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

421+ RKernel -> checkDepsHelp root results otherDeps new same cached importProblems isBlocked

483−

484

422

485 [] ->

423 [] ->

486− case reverse importProblems of

424+ case importProblems of

487 p:ps ->

425 p:ps ->

488 return $ DepsNotFound (NE.List p ps)

426 return $ DepsNotFound (NE.List p ps)

489

427

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

491 if isBlocked then

429 if isBlocked then

492 return $ DepsBlock

430 return $ DepsBlock

493

431

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

432+ else if null new then

495 return $ DepsSame same cached

433 return $ DepsSame same cached

496

434

497 else

435 else

498− do maybeLoaded <- loadInterfaces root same cached

436+ do maybeLoaded <- checkCachedInterfaces root cached

499 case maybeLoaded of

437 case maybeLoaded of

438+ Nothing ->

500− Nothing -> return DepsBlock

439+ return DepsBlock

440+

441+ Just loaded ->

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

442+ return $ DepsChange $

443+ Map.union loaded (Map.union (Map.fromList new) (Map.fromList same))

502

444

503

445

504

446

@@ -506,7 +448,7 @@ checkDepsHelp root results deps new same cached importProblems isBlocked lastDep

506

448

507

449

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

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

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

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

510 let

452 let

511 knownModules =

453 knownModules =

512 Set.unions

454 Set.unions

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

528

470

529

471

530

472

531−-- LOAD CACHED INTERFACES

473+-- CACHED INTERFACE

532

474

533

475

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

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

535−loadInterfaces root same cached =

477+checkCachedInterfaces root deps =

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

478+ do loading <- traverse (fork . checkCache root) deps

537− maybeLoaded <- traverse readMVar loading

479+ loaded <- traverse readMVar loading

538− case sequence maybeLoaded of

480+ return $ Map.fromList <$> sequence loaded

539− Nothing ->

540− return Nothing

541−

542− Just loaded ->

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

544

481

545

482

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

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

547−loadInterface root (name, ciMvar) =

484+checkCache root (name, ciMvar) =

548 do cachedInterface <- takeMVar ciMvar

485 do cachedInterface <- takeMVar ciMvar

549 case cachedInterface of

486 case cachedInterface of

550 Corrupted ->

487 Corrupted ->

@@ -571,8 +508,8 @@ loadInterface root (name, ciMvar) =

571-- CHECK PROJECT

508-- CHECK PROJECT

572

509

573

510

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

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

575−checkMidpoint dmvar statuses =

512+checkExposedMidpoint dmvar statuses =

576 case checkForCycles statuses of

513 case checkForCycles statuses of

577 Nothing ->

514 Nothing ->

578 do maybeForeigns <- readMVar dmvar

515 do maybeForeigns <- readMVar dmvar

@@ -585,11 +522,11 @@ checkMidpoint dmvar statuses =

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

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

586

523

587

524

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

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

589−checkMidpointAndRoots dmvar statuses sroots =

526+checkMainsMidpoint dmvar statuses smains =

590 case checkForCycles statuses of

527 case checkForCycles statuses of

591 Nothing ->

528 Nothing ->

592− case checkUniqueRoots statuses sroots of

529+ case checkUniqueMains statuses smains of

593 Nothing ->

530 Nothing ->

594 do maybeForeigns <- readMVar dmvar

531 do maybeForeigns <- readMVar dmvar

595 case maybeForeigns of

532 case maybeForeigns of

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

640 let

577 let

641 dependencies =

578 dependencies =

642 case status of

579 case status of

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

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

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

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

645− SBadImport _ -> []

582+ SBadImport _ -> []

646− SBadSyntax _ _ _ _ -> []

583+ SBadSyntax _ _ _ _ -> []

647− SForeign _ -> []

584+ SForeign _ -> []

648− SKernel -> []

585+ SKernel -> []

649 in

586 in

650 (name, name, dependencies) : graph

587 (name, name, dependencies) : graph

651

588

652

589

653

590

654−-- CHECK UNIQUE ROOTS

591+-- CHECK UNIQUE MAINS

655

592

656

593

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

594+checkUniqueMains :: Map.Map ModuleName.Raw Status -> NE.List MainStatus -> Maybe Exit.BuildProjectProblem

658−checkUniqueRoots insides sroots =

595+checkUniqueMains insides smains =

659 let

596 let

660 outsidesDict =

597 outsidesDict =

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

598+ Map.fromListWith OneOrMore.more (Maybe.mapMaybe mainStatusToNamePathPair (NE.toList smains))

662 in

599 in

663 case Map.traverseWithKey checkOutside outsidesDict of

600 case Map.traverseWithKey checkOutside outsidesDict of

664 Left problem ->

601 Left problem ->

@@ -670,78 +607,61 @@ checkUniqueRoots insides sroots =

670 Left problem -> Just problem

607 Left problem -> Just problem

671

608

672

609

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

610+mainStatusToNamePathPair :: MainStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)

674−rootStatusToNamePathPair sroot =

611+mainStatusToNamePathPair smain =

675− case sroot of

612+ case smain of

676− SInside _ -> Nothing

613+ SInside _ -> Nothing

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

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

678− SOutsideErr _ -> Nothing

615+ SOutsideErr _ -> Nothing

679

616

680

617

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

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

682checkOutside name paths =

619checkOutside name paths =

683 case OneOrMore.destruct NE.List paths of

620 case OneOrMore.destruct NE.List paths of

684 NE.List p [] -> Right p

621 NE.List p [] -> Right p

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

622+ NE.List p1 (p2:_) -> Left (Exit.BP_MainNameDuplicate name p1 p2)

686

623

687

624

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

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

689checkInside name p1 status =

626checkInside name p1 status =

690 case status of

627 case status of

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

628+ SCached (Details.Local p2 _ _ _) -> Left (Exit.BP_MainNameDuplicate name p1 p2)

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

629+ SChanged (Details.Local p2 _ _ _) _ _ -> Left (Exit.BP_MainNameDuplicate name p1 p2)

693− SBadImport _ -> Right ()

630+ SBadImport _ -> Right ()

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

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

695− SForeign _ -> Right ()

632+ SForeign _ -> Right ()

696− SKernel -> Right ()

633+ SKernel -> Right ()

697

634

698

635

699

636

700-- COMPILE MODULE

637-- COMPILE MODULE

701

638

702

639

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

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

704−compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path time deps main lastChange _) source ifaces modul =

641+compile (Env key root pkg _ _ _) local@(Details.Local path time _ _) source ifaces modul =

705− let

706− pkg = projectTypeToPkg projectType

707− in

708 case Compile.compile pkg ifaces modul of

642 case Compile.compile pkg ifaces modul of

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

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

710− case makeDocs docsNeed canonical of

711− Left err ->

712− return $ RProblem $

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

714−

715− Right docs ->

716− do let name = Src.getName modul

644+ do let name = Src.getName modul

717− let iface = I.fromModule pkg canonical annotations

645+ let iface = I.fromModule pkg canonical annotations

718− let elmi = Stuff.elmi root name

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

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

720− maybeOldi <- File.readBinary elmi

647+ maybeOldi <- File.readBinary (Stuff.elmi root name)

721− case maybeOldi of

648+ case maybeOldi of

722− Just oldi | oldi == iface ->

649+ Just oldi | oldi == iface ->

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

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

724− Reporting.report key Reporting.BDone

651+ Reporting.report key Reporting.BDone

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

726− return (RSame local iface objects docs)

652+ return (RSame local iface objects)

727−

653+

728− _ ->

654+ _ ->

729− do -- iface may be lazy still

655+ do -- iface may be lazy still

656+ -- TODO try adding forkIO here

730− File.writeBinary elmi iface

657+ File.writeBinary (Stuff.elmi root name) iface

731− Reporting.report key Reporting.BDone

658+ Reporting.report key Reporting.BDone

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

733− return (RNew local iface objects docs)

659+ return (RNew local iface objects)

734

660

735 Left err ->

661 Left err ->

662+ do Reporting.report key Reporting.BDone

736− return $ RProblem $

663+ return $ RProblem $

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

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

745

665

746

666

747

667

@@ -749,210 +669,64 @@ projectTypeToPkg projectType =

749

669

750

670

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

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

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

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

753 File.writeBinary (Stuff.details root) $

673 File.writeBinary (Stuff.details root) $

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

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

755

675

756

676

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

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

758addNewLocal name result locals =

678addNewLocal name result locals =

759 case result of

679 case result of

760− RNew local _ _ _ -> Map.insert name local locals

680+ RNew local _ _ -> Map.insert name local locals

761− RSame local _ _ _ -> Map.insert name local locals

681+ RSame local _ _ -> Map.insert name local locals

762− RCached _ _ _ -> locals

682+ RCached _ _ -> locals

763− RNotFound _ -> locals

683+ RNotFound _ -> locals

764− RProblem _ -> locals

684+ RProblem _ -> locals

765− RBlocked -> locals

685+ RBlocked -> locals

766− RForeign _ -> locals

686+ RForeign _ -> locals

767− RKernel -> locals

687+ RKernel -> locals

768

688

769

689

770

690

771−-- FINALIZE EXPOSED

691+-- DETECT EXPOSED PROBLEMS

772

692

773

693

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

694+detectExposedProblems :: NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> Either Exit.BuildProblem ()

775−finalizeExposed root docsGoal exposed results =

695+detectExposedProblems exposed results =

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

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

777 p:ps ->

697 p:ps ->

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

698+ Left (Exit.BuildProjectProblem (Exit.BP_MissingExposed (NE.List p ps)))

779

699

780 [] ->

700 [] ->

781 case Map.foldr addErrors [] results of

701 case Map.foldr addErrors [] results of

782− [] -> Right <$> finalizeDocs docsGoal results

702+ [] -> Right ()

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

703+ e:es -> Left (Exit.BuildModuleProblems e es)

784

704

785

705

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

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

787addErrors result errors =

707addErrors result errors =

788 case result of

708 case result of

789− RNew _ _ _ _ -> errors

709+ RNew _ _ _ -> errors

790− RSame _ _ _ _ -> errors

710+ RSame _ _ _ -> errors

791− RCached _ _ _ -> errors

711+ RCached _ _ -> errors

792− RNotFound _ -> errors

712+ RNotFound _ -> errors

793− RProblem e -> e:errors

713+ RProblem e -> e:errors

794− RBlocked -> errors

714+ RBlocked -> errors

795− RForeign _ -> errors

715+ RForeign _ -> errors

796− RKernel -> errors

716+ RKernel -> errors

797

717

798

718

799addImportProblems :: Map.Map ModuleName.Raw Result -> ModuleName.Raw -> [(ModuleName.Raw, Import.Problem)] -> [(ModuleName.Raw, Import.Problem)]

719addImportProblems :: Map.Map ModuleName.Raw Result -> ModuleName.Raw -> [(ModuleName.Raw, Import.Problem)] -> [(ModuleName.Raw, Import.Problem)]

800addImportProblems results name problems =

720addImportProblems results name problems =

801 case results ! name of

721 case results ! name of

802− RNew _ _ _ _ -> problems

722+ RNew _ _ _ -> problems

803− RSame _ _ _ _ -> problems

723+ RSame _ _ _ -> problems

804− RCached _ _ _ -> problems

724+ RCached _ _ -> problems

805− RNotFound p -> (name, p) : problems

725+ RNotFound p -> (name, p) : problems

806− RProblem _ -> problems

726+ RProblem _ -> problems

807− RBlocked -> problems

727+ RBlocked -> problems

808− RForeign _ -> problems

728+ RForeign _ -> problems

809− RKernel -> problems

729+ RKernel -> problems

810−

811−

812−

813−-- DOCS

814−

815−

816−data DocsGoal a where

817− KeepDocs :: DocsGoal Docs.Documentation

818− WriteDocs :: FilePath -> DocsGoal ()

819− IgnoreDocs :: DocsGoal ()

820−

821−

822−newtype DocsNeed =

823− DocsNeed { needsDocs :: Bool }

824−

825−

826−toDocsNeed :: DocsGoal a -> DocsNeed

827−toDocsNeed goal =

828− case goal of

829− IgnoreDocs -> DocsNeed False

830− WriteDocs _ -> DocsNeed True

831− KeepDocs -> DocsNeed True

832−

833−

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

835−makeDocs (DocsNeed isNeeded) modul =

836− if isNeeded then

837− case Docs.fromModule modul of

838− Right docs -> Right (Just docs)

839− Left err -> Left err

840− else

841− Right Nothing

842−

843−

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

845−finalizeDocs goal results =

846− case goal of

847− KeepDocs ->

848− return $ Map.mapMaybe toDocs results

849−

850− WriteDocs path ->

851− E.writeUgly path $ Docs.encode $ Map.mapMaybe toDocs results

852−

853− IgnoreDocs ->

854− return ()

855−

856−

857−toDocs :: Result -> Maybe Docs.Module

858−toDocs result =

859− case result of

860− RNew _ _ _ d -> d

861− RSame _ _ _ d -> d

862− RCached _ _ _ -> Nothing

863− RNotFound _ -> Nothing

864− RProblem _ -> Nothing

865− RBlocked -> Nothing

866− RForeign _ -> Nothing

867− RKernel -> Nothing

868−

869−

870−

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

730

957

731

958

732

@@ -964,25 +738,25 @@ finalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Mod

964

738

965

739

966

740

967−-- FIND ROOT

741+-- FIND MAIN

968

742

969

743

970−data RootLocation

744+data MainLocation

971 = LInside ModuleName.Raw

745 = LInside ModuleName.Raw

972 | LOutside FilePath

746 | LOutside FilePath

973

747

974

748

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

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

976−findRoots env paths =

750+findMains env paths =

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

751+ do mvars <- traverse (fork . findLocation env) paths

978− einfos <- traverse readMVar mvars

752+ elocs <- traverse readMVar mvars

979− return $ checkRoots =<< sequence einfos

753+ return $ checkLocations =<< sequence elocs

980

754

981

755

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

756+checkLocations :: NE.List Location -> Either Exit.BuildProjectProblem (NE.List MainLocation)

983−checkRoots infos =

757+checkLocations locations =

984 let

758 let

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

759+ toOneOrMore loc@(Location absolute _ _) =

986 (absolute, OneOrMore.one loc)

760 (absolute, OneOrMore.one loc)

987

761

988 fromOneOrMore loc locs =

762 fromOneOrMore loc locs =

@@ -990,83 +764,71 @@ checkRoots infos =

990 [] -> Right ()

764 [] -> Right ()

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

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

992 in

766 in

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

767+ fmap (\_ -> fmap _location locations) $

994 traverse (OneOrMore.destruct fromOneOrMore) $

768 traverse (OneOrMore.destruct fromOneOrMore) $

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

769+ Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList locations)

996

770

997

771

998

772

999−-- ROOT INFO

773+-- LOCATIONS

1000

774

1001

775

1002−data RootInfo =

776+data Location =

1003− RootInfo

777+ Location

1004 { _absolute :: FilePath

778 { _absolute :: FilePath

1005 , _relative :: FilePath

779 , _relative :: FilePath

1006− , _location :: RootLocation

780+ , _location :: MainLocation

1007 }

781 }

1008

782

1009

783

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

784+findLocation :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem Location)

1011−getRootInfo env path =

785+findLocation env path =

1012 do exists <- File.exists path

786 do exists <- File.exists path

1013 if exists

787 if exists

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

788+ then isInsideSrcDirs env path <$> Dir.canonicalizePath path

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

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

1016

790

1017

791

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

792+isInsideSrcDirs :: Env -> FilePath -> FilePath -> Either Exit.BuildProjectProblem Location

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

793+isInsideSrcDirs (Env _ root _ srcDirs _ _) path absolutePath =

1020 let

794 let

1021 (dirs, file) = FP.splitFileName absolutePath

795 (dirs, file) = FP.splitFileName absolutePath

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

796+ (final, ext) = break (=='.') file

1023 in

797 in

1024 if ext /= ".elm"

798 if ext /= ".elm"

1025− then

1026− return $ Left $ Exit.BP_WithBadExtension path

799+ then Left (Exit.BP_WithBadExtension path)

1027 else

800 else

1028 let

801 let

802+ roots = FP.splitDirectories root

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

803+ segments = FP.splitDirectories dirs ++ [final]

1030 in

804 in

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

805+ case dropPrefix roots segments of

1032− [] ->

806+ Nothing ->

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

807+ Right (Location absolutePath path (LOutside path))

1034−

808+

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

809+ Just relativeSegments ->

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

810+ let

1037− matchingDirs <- filterM (isInsideSrcDirByName names) srcDirs

811+ (exits, maybes) =

1038− case matchingDirs of

812+ Either.partitionEithers (map (isInsideSrcDirsHelp relativeSegments) srcDirs)

1039− d1:d2:_ ->

813+ in

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

814+ -- TODO make sure this is all correct

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

815+ case (exits, Maybe.catMaybes maybes) of

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

1043−

1044− _ ->

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

816+ (_, [(_,name)]) -> Right (Location absolutePath path (LInside name))

1046−

817+ ([], []) -> Right (Location absolutePath path (LOutside path))

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

818+ (_, (s1,_):(s2,_):_) -> Left (Exit.BP_WithAmbiguousSrcDir s1 s2)

1052−

819+ (exit:_, _) -> Left exit

1053−

820+

1054−

821+

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

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

1056−isInsideSrcDirByName names srcDir =

823+isInsideSrcDirsHelp segments 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) =

1062 case dropPrefix (FP.splitDirectories srcDir) segments of

824 case dropPrefix (FP.splitDirectories srcDir) segments of

1063 Nothing ->

825 Nothing ->

1064− Nothing

826+ Right Nothing

1065

827

1066 Just names ->

828 Just names ->

1067 if all isGoodName names

829 if all isGoodName names

1068− then Just (srcDir, Right names)

830+ then Right (Just (srcDir, Name.fromChars (List.intercalate "." names)))

1069− else Just (srcDir, Left names)

831+ else Left (error "Exit.MakeWithInvalidModuleName" srcDir segments)

1070

832

1071

833

1072isGoodName :: [Char] -> Bool

834isGoodName :: [Char] -> Bool

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

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

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

1080

842

1081

843

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

1083−--

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

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

1085dropPrefix roots paths =

845dropPrefix roots paths =

1086 case roots of

846 case roots of

@@ -1089,37 +849,37 @@ dropPrefix roots paths =

1089

849

1090 r:rs ->

850 r:rs ->

1091 case paths of

851 case paths of

1092− [] -> Nothing

852+ [] -> Nothing

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

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

1094

854

1095

855

1096

856

1097−-- CRAWL ROOTS

857+-- CRAWL MAINS

1098

858

1099

859

1100−data RootStatus

860+data MainStatus

1101 = SInside ModuleName.Raw

861 = SInside ModuleName.Raw

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

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

1103 | SOutsideErr Error.Module

863 | SOutsideErr Error.Module

1104

864

1105

865

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

866+crawlMain :: Env -> MVar StatusDict -> MainLocation -> IO MainStatus

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

867+crawlMain env@(Env _ _ pkg _ _ _) mvar given =

1108− case root of

868+ case given of

1109 LInside name ->

869 LInside name ->

1110 do statusMVar <- newEmptyMVar

870 do statusMVar <- newEmptyMVar

1111 statusDict <- takeMVar mvar

871 statusDict <- takeMVar mvar

1112 putMVar mvar (Map.insert name statusMVar statusDict)

872 putMVar mvar (Map.insert name statusMVar statusDict)

1113− putMVar statusMVar =<< crawlModule env mvar (DocsNeed False) name

873+ putMVar statusMVar =<< crawlModule env mvar name

1114 return (SInside name)

874 return (SInside name)

1115

875

1116 LOutside path ->

876 LOutside path ->

1117 do time <- File.getTime path

877 do time <- File.getTime path

1118 source <- File.readUtf8 path

878 source <- File.readUtf8 path

1119− case Parse.fromByteString projectType source of

879+ case Parse.fromByteString pkg source of

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

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

1121 do let deps = map Src.getImportName imports

881 do let deps = map Src.getImportName imports

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

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

1123 crawlDeps env mvar deps (SOutsideOk local source modul)

883 crawlDeps env mvar deps (SOutsideOk local source modul)

1124

884

1125 Left syntaxError ->

885 Left syntaxError ->

@@ -1128,36 +888,40 @@ crawlRoot env@(Env _ _ projectType _ buildID _ _) mvar root =

1128

888

1129

889

1130

890

1131−-- CHECK ROOTS

891+-- CHECK MAINS

1132

892

1133

893

1134−data RootResult

894+data MainResult

1135 = RInside ModuleName.Raw

895 = RInside ModuleName.Raw

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

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

1137 | ROutsideErr Error.Module

897 | ROutsideErr Error.Module

1138 | ROutsideBlocked

898 | ROutsideBlocked

1139

899

1140

900

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

901+checkMain :: Env -> ResultDict -> MainStatus -> IO MainResult

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

902+checkMain env@(Env _ root _ _ _ _) results pendingMain =

1143− case rootStatus of

903+ case pendingMain of

1144 SInside name ->

904 SInside name ->

1145 return (RInside name)

905 return (RInside name)

1146

906

1147 SOutsideErr err ->

907 SOutsideErr err ->

1148 return (ROutsideErr err)

908 return (ROutsideErr err)

1149

909

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

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

1151− do depsStatus <- checkDeps root results deps lastCompile

911+ do depsStatus <- checkDeps root results deps

1152 case depsStatus of

912 case depsStatus of

1153 DepsChange ifaces ->

913 DepsChange ifaces ->

1154− compileOutside env local source ifaces modul

914+ return $ compileOutside env local source ifaces modul

1155

915

1156 DepsSame same cached ->

916 DepsSame same cached ->

1157− do maybeLoaded <- loadInterfaces root same cached

917+ do maybeLoaded <- checkCachedInterfaces root cached

1158 case maybeLoaded of

918 case maybeLoaded of

919+ Nothing ->

1159− Nothing -> return ROutsideBlocked

920+ return ROutsideBlocked

921+

922+ Just loaded ->

923+ do let ifaces = Map.union loaded (Map.fromList same)

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

924+ return $ compileOutside env local source ifaces modul

1161

925

1162 DepsBlock ->

926 DepsBlock ->

1163 return ROutsideBlocked

927 return ROutsideBlocked

@@ -1167,54 +931,53 @@ checkRoot env@(Env _ root _ _ _ _ _) results rootStatus =

1167 Error.BadImports (toImportErrors env results imports problems)

931 Error.BadImports (toImportErrors env results imports problems)

1168

932

1169

933

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

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

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

935+compileOutside (Env _ _ pkg _ _ _) (Details.Local path time _ _) source ifaces modul =

1172 let

936 let

1173− pkg = projectTypeToPkg projectType

1174 name = Src.getName modul

937 name = Src.getName modul

1175 in

938 in

1176 case Compile.compile pkg ifaces modul of

939 case Compile.compile pkg ifaces modul of

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

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

1178− do Reporting.report key Reporting.BDone

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

941+ ROutsideOk name (I.fromModule pkg canonical annotations) objects

1180

942

1181 Left errors ->

943 Left errors ->

944+ ROutsideErr $

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

945+ Error.Module name path time source errors

1183

946

1184

947

1185

948

1186-- TO ARTIFACTS

949-- TO ARTIFACTS

1187

950

1188

951

1189−data Root

952+data Main

1190 = Inside ModuleName.Raw

953 = Inside ModuleName.Raw

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

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

1192

955

1193

956

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

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

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

958+toArtifacts (Env _ _ pkg _ _ _) foreigns results mainResults =

1196− case gatherProblemsOrMains results rootResults of

959+ case gatherProblemsOrMains results mainResults of

1197 Left (NE.List e es) ->

960 Left (NE.List e es) ->

1198− Left (Exit.BuildBadModules root e es)

961+ Left (Exit.BuildModuleProblems e es)

1199

962

1200− Right roots ->

963+ Right mains ->

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

964+ Right $ Artifacts pkg foreigns mains $

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

965+ Map.foldrWithKey addInside (foldr addOutside [] mainResults) results

1203

966

1204

967

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

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

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

969+gatherProblemsOrMains results (NE.List mainResult mainResults) =

1207 let

970 let

1208− addResult result (es, roots) =

971+ sortMain result (es, mains) =

1209 case result of

972 case result of

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

973+ RInside n -> ( es, Inside n : mains)

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

974+ ROutsideOk n i o -> ( es, Outside n i o : mains)

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

975+ ROutsideErr e -> (e:es, mains)

1213− ROutsideBlocked -> ( es, roots)

976+ ROutsideBlocked -> ( es, mains)

1214

977

1215 errors = Map.foldr addErrors [] results

978 errors = Map.foldr addErrors [] results

1216 in

979 in

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

980+ case (mainResult, foldr sortMain (errors, []) mainResults) of

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

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

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

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

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

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

@@ -1227,14 +990,14 @@ gatherProblemsOrMains results (NE.List rootResult rootResults) =

1227addInside :: ModuleName.Raw -> Result -> [Module] -> [Module]

990addInside :: ModuleName.Raw -> Result -> [Module] -> [Module]

1228addInside name result modules =

991addInside name result modules =

1229 case result of

992 case result of

1230− RNew _ iface objs _ -> Fresh name iface objs : modules

993+ RNew _ iface objs -> Fresh name iface objs : modules

1231− RSame _ iface objs _ -> Fresh name iface objs : modules

994+ RSame _ iface objs -> Fresh name iface objs : modules

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

995+ RCached main mvar -> Cached name main mvar : modules

1233− RNotFound _ -> error (badInside name)

996+ RNotFound _ -> error (badInside name)

1234− RProblem _ -> error (badInside name)

997+ RProblem _ -> error (badInside name)

1235− RBlocked -> error (badInside name)

998+ RBlocked -> error (badInside name)

1236− RForeign _ -> modules

999+ RForeign _ -> modules

1237− RKernel -> modules

1000+ RKernel -> modules

1238

1001

1239

1002

1240badInside :: ModuleName.Raw -> [Char]

1003badInside :: ModuleName.Raw -> [Char]

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

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

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

1243

1006

1244

1007

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

1008+addOutside :: MainResult -> [Module] -> [Module]

1246−addOutside root modules =

1009+addOutside main modules =

1247− case root of

1010+ case main of

1248 RInside _ -> modules

1011 RInside _ -> modules

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

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

1250 ROutsideErr _ -> modules

1013 ROutsideErr _ -> modules

builder/src/Deps/Bump.hsdeleted−37

@@ -1,37 +0,0 @@

1−module Deps.Bump

2− ( getPossibilities

3− )

4− where

5−

6−

7−import qualified Data.List as List

8−

9−import qualified Deps.Registry as Registry

10−import qualified Elm.Magnitude as M

11−import qualified Elm.Version as V

12−

13−

14−

15−-- GET POSSIBILITIES

16−

17−

18−getPossibilities :: Registry.KnownVersions -> [(V.Version, V.Version, M.Magnitude)]

19−getPossibilities (Registry.KnownVersions latest previous) =

20− let

21− allVersions = reverse (latest:previous)

22− minorPoints = map last (List.groupBy sameMajor allVersions)

23− patchPoints = map last (List.groupBy sameMinor allVersions)

24− in

25− (latest, V.bumpMajor latest, M.MAJOR)

26− : map (\v -> (v, V.bumpMinor v, M.MINOR)) minorPoints

27− ++ map (\v -> (v, V.bumpPatch v, M.PATCH)) patchPoints

28−

29−

30−sameMajor :: V.Version -> V.Version -> Bool

31−sameMajor (V.Version major1 _ _) (V.Version major2 _ _) =

32− major1 == major2

33−

34−

35−sameMinor :: V.Version -> V.Version -> Bool

36−sameMinor (V.Version major1 minor1 _) (V.Version major2 minor2 _) =

37− major1 == major2 && minor1 == minor2

builder/src/Deps/Diff.hs+5−7

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

18import qualified Data.Map as Map

19import qualified Data.Name as Name

20import qualified Data.Set as Set

21−import qualified System.Directory as Dir

21+import qualified Data.Utf8 as Utf8

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

24import qualified Deps.Website as Website

@@ -204,7 +204,7 @@ isSameName :: Name.Name -> Name.Name -> Bool

204isSameName oldFullName newFullName =

205 let

206 dedot name =

207− reverse (Name.splitDots name)

207+ reverse (Utf8.split 0x2E {-.-} (Name.toUtf8 name))

208 in

209 case ( dedot oldFullName, dedot newFullName ) of

210 (oldName:[], newName:_) ->

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

357

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

359getDocs cache manager name version =

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

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

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

362 exists <- File.exists path

361 exists <- File.exists path

363 if exists

362 if exists

364 then

363 then

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

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

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

376 case D.fromByteString Docs.decoder body of

375 case D.fromByteString Docs.decoder body of

377 Right docs ->

376 Right docs ->

378− do Dir.createDirectoryIfMissing True home

379− File.writeUtf8 path body

377+ do File.writeUtf8 path body

380 return $ Right docs

378 return $ Right docs

381

379

382 Left _ ->

380 Left _ ->

383− return $ Left $ Exit.DP_Data url body

381+ return $ Left Exit.DP_Data

builder/src/Deps/Registry.hs+68−35

@@ -16,8 +16,11 @@ module Deps.Registry

16import Prelude hiding (read)

17import Control.Monad (liftM2)

18import Data.Binary (Binary, get, put)

19+import Data.Function (on)

19import qualified Data.List as List

20import qualified Data.List as List

20import qualified Data.Map.Strict as Map

21import qualified Data.Map.Strict as Map

22+import qualified Data.Name as Name

23+import qualified Data.Utf8 as Utf8

22import qualified Deps.Website as Website

25import qualified Deps.Website as Website

23import qualified Elm.Package as Pkg

26import qualified Elm.Package as Pkg

@@ -25,8 +28,8 @@ import qualified Elm.Version as V

25import qualified File

28import qualified File

26import qualified Http

29import qualified Http

27import qualified Json.Decode as D

30import qualified Json.Decode as D

28−import qualified Parse.Primitives as P

29import qualified Reporting.Exit as Exit

31import qualified Reporting.Exit as Exit

32+import qualified Reporting.Suggest as Suggest

30import qualified Stuff

33import qualified Stuff

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

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

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

56read cache =

59read cache =

57− File.readBinary (Stuff.registry cache)

60+ do let path = Stuff.registry cache

61+ exists <- File.exists path

62+ if exists

63+ then File.readBinary path

64+ else return Nothing

@@ -79,19 +86,26 @@ addEntry (KnownVersions _ vs) count =

80allPkgsDecoder :: D.Decoder () (Map.Map Pkg.Name KnownVersions)

87allPkgsDecoder :: D.Decoder () (Map.Map Pkg.Name KnownVersions)

81allPkgsDecoder =

88allPkgsDecoder =

82− let

89+ do pairs <- D.pairs (D.list (D.mapError (\_ -> ()) V.decoder))

83− keyDecoder =

90+ checkKeys pairs Map.empty

84− Pkg.keyDecoder bail

91+ where

92+ checkKeys pairs pkgs =

93+ case pairs of

94+ [] ->

95+ return pkgs

86− versionsDecoder =

97+ (key, versions) : rest ->

87− D.list (D.mapError (\_ -> ()) V.decoder)

98+ case Pkg.fromString key of

99+ Right pkg ->

100+ case List.sortBy (flip compare) versions of

101+ [] ->

102+ D.failure ()

103

89− toKnownVersions versions =

104+ v:vs ->

90− case List.sortBy (flip compare) versions of

91− v:vs -> return (KnownVersions v vs)

105+ checkKeys rest (Map.insert pkg (KnownVersions v vs) pkgs)

106+

107+ Left _ ->

92− [] -> D.failure ()

108+ D.failure ()

93− in

94− D.dict keyDecoder (toKnownVersions =<< versionsDecoder)

109

110

111

@@ -130,26 +144,22 @@ addNew (name, version) versions =

130 Map.alter (Just . add) name versions

144 Map.alter (Just . add) name versions

131

145

132

146

133−

134−-- NEW PACKAGE DECODER

135−

136−

137newPkgDecoder :: D.Decoder () (Pkg.Name, V.Version)

147newPkgDecoder :: D.Decoder () (Pkg.Name, V.Version)

138newPkgDecoder =

148newPkgDecoder =

139− D.customString newPkgParser bail

149+ do str <- D.string

140−

150+ case Utf8.split 0x40 {-@-} str of

151+ [key, value] ->

152+ case Pkg.fromString key of

153+ Right pkg ->

154+ case V.fromString value of

155+ Just vsn -> return (pkg, vsn)

156+ Nothing -> D.failure ()

141

157

142−newPkgParser :: P.Parser () (Pkg.Name, V.Version)

158+ Left _ ->

143−newPkgParser =

159+ D.failure ()

144− do pkg <- P.specialize (\_ _ _ -> ()) Pkg.parser

145− P.word1 0x40 {-@-} bail

146− vsn <- P.specialize (\_ _ _ -> ()) V.parser

147− return (pkg, vsn)

148

160

149−

161+ _ ->

150−bail :: row -> col -> ()

162+ D.failure ()

151−bail _ _ =

152− ()

153

163

154

164

155

165

@@ -180,7 +190,33 @@ getVersions' :: Pkg.Name -> Registry -> Either [Pkg.Name] KnownVersions

180getVersions' name (Registry _ versions) =

190getVersions' name (Registry _ versions) =

181 case Map.lookup name versions of

191 case Map.lookup name versions of

182 Just kvs -> Right kvs

192 Just kvs -> Right kvs

183− Nothing -> Left $ Pkg.nearbyNames name (Map.keys versions)

193+ Nothing -> Left $ nearbyNames name (Map.keys versions)

194+

195+

196+nearbyNames :: Pkg.Name -> [Pkg.Name] -> [Pkg.Name]

197+nearbyNames (Pkg.Name author1 project1) possibleNames =

198+ let

199+ authorDist = authorDistance (Name.toChars author1)

200+ projectDist = projectDistance (Name.toChars project1)

201+

202+ addDistance name@(Pkg.Name author2 project2) =

203+ ( authorDist author2 + projectDist project2, name )

204+ in

205+ map snd $ take 4 $

206+ List.sortBy (compare `on` fst) $

207+ map addDistance possibleNames

208+

209+

210+authorDistance :: String -> Name.Name -> Int

211+authorDistance bad possibility =

212+ abs (Suggest.distance bad (Name.toChars possibility))

213+

214+

215+projectDistance :: String -> Name.Name -> Int

216+projectDistance bad possibility =

217+ if possibility == "elm" || possibility == "elm-explorations"

218+ then 0

219+ else abs (Suggest.distance bad (Name.toChars possibility))

184

220

185

221

186

222

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

189

225

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

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

191post manager path decoder callback =

227post manager path decoder callback =

192− let

193− url = Website.route path []

194− in

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

228+ Http.post manager (Website.route path []) [] Exit.RP_Http $

196 \body ->

229 \body ->

197 case D.fromByteString decoder body of

230 case D.fromByteString decoder body of

198 Right a -> Right <$> callback a

231 Right a -> Right <$> callback a

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

232+ Left _ -> return $ Left Exit.RP_Data

200

233

201

234

202

235

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

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

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

96verify cache connection registry constraints =

97− Stuff.withRegistryLock cache $

98 case try constraints of

97 case try constraints of

99 Solver solver ->

98 Solver solver ->

100 solver (State cache connection registry Map.empty)

99 solver (State cache connection registry Map.empty)

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

131

130

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

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

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

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

134− Stuff.withRegistryLock cache $

135 let

133 let

136 allIndirects = Map.union indirect testIndirect

134 allIndirects = Map.union indirect testIndirect

137 allDirects = Map.union direct testDirect

135 allDirects = Map.union direct testDirect

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

313 back state

311 back state

314

312

315 Online manager ->

313 Online manager ->

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

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

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

318 case result of

315 case result of

319 Left httpProblem ->

316 Left httpProblem ->

320− err (Exit.SolverBadHttp pkg vsn httpProblem)

317+ err (Exit.SolverBadHttp httpProblem)

321

318

322 Right body ->

319 Right body ->

323 case D.fromByteString constraintsDecoder body of

320 case D.fromByteString constraintsDecoder body of

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

327 ok (toNewState cs) cs back

324 ok (toNewState cs) cs back

328

325

329 Left _ ->

326 Left _ ->

330− err (Exit.SolverBadHttpData pkg vsn url)

327+ err (Exit.SolverBadHttpData pkg vsn)

331

328

332

329

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

331+--

333constraintsDecoder :: D.Decoder () Constraints

332constraintsDecoder :: D.Decoder () Constraints

334constraintsDecoder =

333constraintsDecoder =

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

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

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

351

350

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

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

353initEnv =

352initEnv =

354− do mvar <- newEmptyMVar

353+ do mvar <- newEmptyMVar

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

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

356− cache <- Stuff.getPackageCache

355+ cache <- Stuff.getPackageCache

357− Stuff.withRegistryLock cache $

358− do maybeRegistry <- Registry.read cache

356+ maybeRegistry <- Registry.read cache

359− manager <- readMVar mvar

357+ manager <- readMVar mvar

360−

358+

361− case maybeRegistry of

359+ case maybeRegistry of

362− Nothing ->

360+ Nothing ->

363− do eitherRegistry <- Registry.fetch manager cache

361+ do eitherRegistry <- Registry.fetch manager cache

364− case eitherRegistry of

362+ case eitherRegistry of

365− Right latestRegistry ->

363+ Right latestRegistry ->

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

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

367−

365+

368− Left problem ->

366+ Left problem ->

369− return $ Left $ problem

367+ return $ Left $ problem

370−

368+

371− Just cachedRegistry ->

369+ Just cachedRegistry ->

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

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

373− case eitherRegistry of

371+ case eitherRegistry of

374− Right latestRegistry ->

372+ Right latestRegistry ->

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

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

376−

374+

377− Left _ ->

375+ Left _ ->

378− return $ Right $ Env cache manager Offline cachedRegistry

376+ return $ Right $ Env cache manager Offline cachedRegistry

379

377

380

378

381

379

builder/src/Elm/Bump.hsnew file+137

@@ -0,0 +1,137 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module Elm.Bump

3+ ( bump

4+ , toPossibleBumps

5+ )

6+ where

9+import Control.Monad.Trans (liftIO)

10+import qualified Data.List as List

11+

12+import qualified Deps.Cache as Cache

13+import qualified Deps.Diff as Diff

14+import qualified Elm.Project.Json as Project

15+import qualified Elm.Project.Summary as Summary

16+import qualified Elm.Version as V

17+import Reporting.Doc ((<>), (<+>))

18+import qualified Reporting.Doc as D

19+import qualified Reporting.Exit as Exit

20+import qualified Reporting.Exit.Bump as E

21+import qualified Reporting.Exit.Help as Help

22+import qualified Reporting.Progress.Terminal as Terminal

23+import qualified Reporting.Task as Task

24+

25+

26+

27+-- BUMP

28+

29+

30+bump :: Summary.Summary -> Task.Task ()

31+bump summary@(Summary.Summary root project _ _ _) =

32+ case project of

33+ Project.App _ ->

34+ Task.throw (Exit.Bump E.Application)

35+

36+ Project.Pkg info@(Project.PkgInfo name _ _ version _ _ _ _) ->

37+ do registry <- Cache.mandatoryUpdate

38+ case Cache.getVersions name registry of

39+ Left _suggestions ->

40+ checkNewPackage root info

41+

42+ Right publishedVersions ->

43+ let

44+ bumpableVersions =

45+ map (\(old, _, _) -> old) (toPossibleBumps publishedVersions)

46+ in

47+ if elem version bumpableVersions then

48+ suggestVersion summary info

49+ else

50+ Task.throw $ Exit.Bump $ E.Unbumpable version $

51+ map head (List.group (List.sort bumpableVersions))

52+

53+

54+

55+-- VALID BUMPS

56+

57+

58+toPossibleBumps :: [V.Version] -> [(V.Version, V.Version, Diff.Magnitude)]

59+toPossibleBumps publishedVersions =

60+ case publishedVersions of

61+ [] ->

62+ []

63+

64+ _ ->

65+ let

66+ patchPoints =

67+ V.filterLatest V.majorAndMinor publishedVersions

68+

69+ minorPoints =

70+ V.filterLatest V._major publishedVersions

71+

72+ majorPoint =

73+ maximum publishedVersions

74+ in

75+ (majorPoint, V.bumpMajor majorPoint, Diff.MAJOR)

76+ : map (\v -> (v, V.bumpMinor v, Diff.MINOR)) minorPoints

77+ ++ map (\v -> (v, V.bumpPatch v, Diff.PATCH)) patchPoints

78+

79+

80+

81+-- CHECK NEW PACKAGE

82+

83+

84+checkNewPackage :: FilePath -> Project.PkgInfo -> Task.Task ()

85+checkNewPackage root info@(Project.PkgInfo _ _ _ version _ _ _ _) =

86+ do liftIO $ putStrLn Terminal.newPackageOverview

87+ if version == V.one

88+ then

89+ liftIO $ putStrLn "The version number in elm.json is correct so you are all set!"

90+ else

91+ changeVersion root info V.one $

92+ "It looks like the version in elm.json has been changed though!\n\

93+ \Would you like me to change it back to "

94+ <> D.fromUtf8 (V.toString V.one) <> "? [Y/n] "

95+

96+

97+

98+-- SUGGEST VERSION

99+

100+

101+suggestVersion :: Summary.Summary -> Project.PkgInfo -> Task.Task ()

102+suggestVersion (Summary.Summary root _ _ _ _) info@(Project.PkgInfo name _ _ version _ _ _ _) =

103+ do oldDocs <- Cache.getDocs name version

104+ newDocs <- Task.silently (error "TODO Project.generateDocs summary")

105+ let changes = Diff.diff oldDocs newDocs

106+ let newVersion = Diff.bump changes version

107+ changeVersion root info newVersion $

108+ let

109+ old = D.fromUtf8 $ V.toString version

110+ new = D.fromUtf8 $ V.toString newVersion

111+ mag = D.fromChars $ Diff.magnitudeToString (Diff.toMagnitude changes)

112+ in

113+ "Based on your new API, this should be a" <+> D.green mag <+> "change (" <> old <> " => " <> new <> ")\n"

114+ <> "Bail out of this command and run 'elm diff' for a full explanation.\n"

115+ <> "\n"

116+ <> "Should I perform the update (" <> old <> " => " <> new <> ") in elm.json? [Y/n] "

117+

118+

119+

120+-- CHANGE VERSION

121+

122+

123+changeVersion :: FilePath -> Project.PkgInfo -> V.Version -> D.Doc -> Task.Task ()

124+changeVersion root info targetVersion explanation =

125+ do approved <- Task.getApproval explanation

126+ if not approved

127+ then

128+ liftIO $ putStrLn "Okay, I did not change anything!"

129+

130+ else

131+ do liftIO $ Project.write root $ Project.Pkg $

132+ info { Project._pkg_version = targetVersion }

133+

134+ liftIO $ Help.toStdout $

135+ "Version changed to "

136+ <> D.green (D.fromUtf8 (V.toString targetVersion))

137+ <> "!\n"

builder/src/Elm/Details.hs+96−193

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

2{-# LANGUAGE BangPatterns, OverloadedStrings #-}

3module Elm.Details

4 ( Details(..)

5− , BuildID

6 , ValidOutline(..)

5 , ValidOutline(..)

7 , Local(..)

6 , Local(..)

8 , Foreign(..)

7 , Foreign(..)

@@ -16,32 +15,25 @@ module Elm.Details

17import Control.Concurrent (forkIO)

16import Control.Concurrent (forkIO)

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

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

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

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

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

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

21−import qualified Data.Either as Either

22import qualified Data.Map as Map

20import qualified Data.Map as Map

23import qualified Data.Map.Utils as Map

21import qualified Data.Map.Utils as Map

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

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

25−import qualified Data.Maybe as Maybe

26import qualified Data.Name as Name

23import qualified Data.Name as Name

27−import qualified Data.NonEmptyList as NE

28import qualified Data.OneOrMore as OneOrMore

24import qualified Data.OneOrMore as OneOrMore

29import qualified Data.Set as Set

25import qualified Data.Set as Set

30import qualified Data.Utf8 as Utf8

26import qualified Data.Utf8 as Utf8

31−import Data.Word (Word64)

32import qualified System.Directory as Dir

27import qualified System.Directory as Dir

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

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

35−import qualified AST.Canonical as Can

36import qualified AST.Source as Src

30import qualified AST.Source as Src

37import qualified AST.Optimized as Opt

31import qualified AST.Optimized as Opt

38−import qualified BackgroundWriter as BW

39import qualified Compile

32import qualified Compile

40import qualified Deps.Registry as Registry

33import qualified Deps.Registry as Registry

41import qualified Deps.Solver as Solver

34import qualified Deps.Solver as Solver

42import qualified Deps.Website as Website

35import qualified Deps.Website as Website

43import qualified Elm.Constraint as Con

36import qualified Elm.Constraint as Con

44−import qualified Elm.Docs as Docs

45import qualified Elm.Interface as I

37import qualified Elm.Interface as I

46import qualified Elm.Kernel as Kernel

38import qualified Elm.Kernel as Kernel

47import qualified Elm.ModuleName as ModuleName

39import qualified Elm.ModuleName as ModuleName

@@ -51,7 +43,6 @@ import qualified Elm.Version as V

51import qualified File

43import qualified File

52import qualified Http

44import qualified Http

53import qualified Json.Decode as D

45import qualified Json.Decode as D

54−import qualified Json.Encode as E

55import qualified Parse.Module as Parse

46import qualified Parse.Module as Parse

56import qualified Reporting

47import qualified Reporting

57import qualified Reporting.Annotation as A

48import qualified Reporting.Annotation as A

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

68 Details

59 Details

69 { _outlineTime :: File.Time

60 { _outlineTime :: File.Time

70 , _outline :: ValidOutline

61 , _outline :: ValidOutline

71− , _buildID :: BuildID

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

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

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

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

74 , _extras :: Extras

64 , _extras :: Extras

75 }

65 }

78−type BuildID = Word64

68+data ValidOutline

69+ = ValidApp Outline.AppOutline

70+ | ValidPkg Outline.PkgOutline (Map.Map Pkg.Name V.Version)

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

99data Local =

73data Local =

100 Local

74 Local

101 { _path :: FilePath

75 { _path :: FilePath

102 , _time :: File.Time

76 , _time :: File.Time

103 , _deps :: [ModuleName.Raw]

77 , _deps :: [ModuleName.Raw]

104 , _main :: Bool

78 , _main :: Bool

105− , _lastChange :: BuildID

106− , _lastCompile :: BuildID

107 }

79 }

108

109

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

125

126

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

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

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

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

129 case extras of

101 case extras of

130 ArtifactsFresh _ o -> newMVar (Just o)

102 ArtifactsFresh _ o -> newMVar (Just o)

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

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

132

104

133

105

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

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

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

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

136 case extras of

108 case extras of

137 ArtifactsFresh i _ -> newMVar (Just i)

109 ArtifactsFresh i _ -> newMVar (Just i)

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

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

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

142-- VERIFY INSTALL -- used by Install

114-- VERIFY INSTALL -- used by Install

143

115

144

116

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

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

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

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

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

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

148 let key = Reporting.ignorer

120 let key = Reporting.ignorer

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

121+ let env = Env key root cache manager connection registry

150 case outline of

122 case outline of

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

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

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

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

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

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

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

157

129

158

130

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

131+load :: Reporting.Style -> FilePath -> IO (Either Exit.Details Details)

160−load style scope root =

132+load style root =

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

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

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

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

163 case maybeDetails of

135 case maybeDetails of

164 Nothing ->

136 Nothing ->

165− generate style scope root newTime

137+ generate style root newTime

166

138

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

139+ Just details@(Details oldTime _ _ _ _) ->

168 if oldTime == newTime

140 if oldTime == newTime

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

141+ then return (Right details)

170− else generate style scope root newTime

142+ else generate style root newTime

171

143

172

144

173

145

174-- GENERATE

146-- GENERATE

175

147

176

148

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

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

178−generate style scope root time =

150+generate style root time =

179 Reporting.trackDetails style $ \key ->

151 Reporting.trackDetails style $ \key ->

180− do result <- initEnv key scope root

152+ do result <- initEnv key root

181 case result of

153 case result of

182 Left exit ->

154 Left exit ->

183 return (Left exit)

155 return (Left exit)

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

195data Env =

167data Env =

196 Env

168 Env

197 { _key :: Reporting.DKey

169 { _key :: Reporting.DKey

198− , _scope :: BW.Scope

199 , _root :: FilePath

170 , _root :: FilePath

200 , _cache :: Stuff.PackageCache

171 , _cache :: Stuff.PackageCache

201 , _manager :: Http.Manager

172 , _manager :: Http.Manager

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

204 }

175 }

205

176

206

177

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

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

208−initEnv key scope root =

179+initEnv key root =

209 do mvar <- fork Solver.initEnv

180 do mvar <- fork Solver.initEnv

210 eitherOutline <- Outline.read root

181 eitherOutline <- Outline.read root

211 case eitherOutline of

182 case eitherOutline of

@@ -219,7 +190,7 @@ initEnv key scope root =

219 return $ Left $ Exit.DetailsCannotGetRegistry problem

190 return $ Left $ Exit.DetailsCannotGetRegistry problem

220

191

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

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

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

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

223

194

224

195

225

196

@@ -230,25 +201,24 @@ type Task a = Task.Task Exit.Details a

230

201

231

202

232verifyPkg :: Env -> File.Time -> Outline.PkgOutline -> Task Details

203verifyPkg :: Env -> File.Time -> Outline.PkgOutline -> Task Details

233−verifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct testDirect elm) =

204+verifyPkg env time outline@(Outline.PkgOutline _ _ _ _ _ direct testDirect elm) =

234 if Con.goodElm elm

205 if Con.goodElm elm

235 then

206 then

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

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

237− let exposedList = Outline.flattenExposed exposed

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

208+ let vsns = Map.map (\(Solver.Details v _) -> v) solution

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

209+ verifyDependencies env time (ValidPkg outline vsns) solution direct

240 else

210 else

241 Task.throw $ Exit.DetailsBadElmInPkg elm

211 Task.throw $ Exit.DetailsBadElmInPkg elm

242

212

243

213

244verifyApp :: Env -> File.Time -> Outline.AppOutline -> Task Details

214verifyApp :: Env -> File.Time -> Outline.AppOutline -> Task Details

245−verifyApp env time outline@(Outline.AppOutline elmVersion srcDirs direct _ _ _) =

215+verifyApp env time outline@(Outline.AppOutline elmVersion _ direct _ _ _) =

246 if elmVersion == V.compiler

216 if elmVersion == V.compiler

247 then

217 then

248 do stated <- checkAppDeps outline

218 do stated <- checkAppDeps outline

249 actual <- verifyConstraints env (Map.map Con.exactly stated)

219 actual <- verifyConstraints env (Map.map Con.exactly stated)

250 if Map.size stated == Map.size actual

220 if Map.size stated == Map.size actual

251− then verifyDependencies env time (ValidApp srcDirs) actual direct

221+ then verifyDependencies env time (ValidApp outline) actual direct

252 else Task.throw $ Exit.DetailsHandEditedDependencies

222 else Task.throw $ Exit.DetailsHandEditedDependencies

253 else

223 else

254 Task.throw $ Exit.DetailsBadElmInAppOutline elmVersion

224 Task.throw $ Exit.DetailsBadElmInAppOutline elmVersion

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

266

236

267

237

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

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

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

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

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

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

271 case result of

241 case result of

272 Solver.Ok details -> return details

242 Solver.Ok details -> return details

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

312

282

313

283

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

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

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

285+verifyDependencies env@(Env key root _ _ _ _) time outline solution directDeps =

316 Task.eio id $

286 Task.eio id $

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

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

318 mvar <- newEmptyMVar

288 mvar <- newEmptyMVar

319− mvars <- Stuff.withRegistryLock cache $

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

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

321 putMVar mvar mvars

290 putMVar mvar mvars

322 deps <- traverse readMVar mvars

291 deps <- traverse readMVar mvars

323 case sequence deps of

292 case sequence deps of

324− Left _ ->

293+ Left problem ->

325− do home <- Stuff.getElmHome

294+ error "TODO verifyDependencies" problem

326− return $ Left $ Exit.DetailsBadDeps home $

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

328

295

329 Right artifacts ->

296 Right artifacts ->

330 let

297 let

331 objs = Map.foldr addObjects Opt.empty artifacts

298 objs = Map.foldr addObjects Opt.empty artifacts

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

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

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

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

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

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

335 in

302 in

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

303+ do File.writeBinary (Stuff.objects root) objs

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

304+ File.writeBinary (Stuff.interfaces root) ifaces

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

305+ File.writeBinary (Stuff.details root) details

339 return (Right details)

306 return (Right details)

340

307

341

308

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

375

342

376

343

377type Dep =

344type Dep =

378− Either (Maybe Exit.DetailsBadDep) Artifacts

345+ Either Problem Artifacts

346+

347+

348+data Problem

349+ = BadDownload Exit.PackageProblem

350+ | BadBuild

351+ | BadDependency

379

352

380

353

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

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

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

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

356+ let

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

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

358+ in

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

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

385 if exists

360 if exists

386 then

361 then

387 do Reporting.report key Reporting.DCached

362 do Reporting.report key Reporting.DCached

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

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

389 case maybeCache of

364 case maybeCache of

390 Nothing ->

365 Nothing ->

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

366+ build key cache depsMVar pkg details (Set.singleton fingerprint)

392

367

393 Just (ArtifactCache fingerprints artifacts) ->

368 Just (ArtifactCache fingerprints artifacts) ->

394 if Set.member fingerprint fingerprints

369 if Set.member fingerprint fingerprints

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

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

396− else build key cache depsMVar pkg details fingerprint fingerprints

371+ else build key cache depsMVar pkg details (Set.insert fingerprint fingerprints)

397 else

372 else

398 do Reporting.report key Reporting.DRequested

373 do Reporting.report key Reporting.DRequested

399 result <- downloadPackage cache manager pkg vsn

374 result <- downloadPackage cache manager pkg vsn

400 case result of

375 case result of

401− Left problem ->

376+ Left p ->

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

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

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

378+ return (Left (BadDownload p))

404

379

405 Right () ->

380 Right () ->

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

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

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

382+ build key cache depsMVar pkg details (Set.singleton fingerprint)

408

383

409

384

410

385

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

426-- BUILD

401-- BUILD

427

402

428

403

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

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

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

405+build key cache depsMVar pkg (Solver.Details vsn _) fingerprints =

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

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

432 case eitherOutline of

407 case eitherOutline of

433 Left _ ->

408 Left _ ->

434 do Reporting.report key Reporting.DBroken

409 do Reporting.report key Reporting.DBroken

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

410+ return (Left BadBuild)

436

411

437 Right (Outline.App _) ->

412 Right (Outline.App _) ->

438 do Reporting.report key Reporting.DBroken

413 do Reporting.report key Reporting.DBroken

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

414+ return (Left BadBuild)

440

415

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

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

442 do allDeps <- readMVar depsMVar

417 do allDeps <- readMVar depsMVar

@@ -444,22 +419,21 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs =

444 case sequence directDeps of

419 case sequence directDeps of

445 Left _ ->

420 Left _ ->

446 do Reporting.report key Reporting.DBroken

421 do Reporting.report key Reporting.DBroken

447− return $ Left $ Nothing

422+ return (Left BadDependency)

448

423

449 Right directArtifacts ->

424 Right directArtifacts ->

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

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

451 let foreignDeps = gatherForeignInterfaces directArtifacts

426 let foreignDeps = gatherForeignInterfaces directArtifacts

452 let exposedDict = Map.fromKeys (\_ -> ()) (Outline.flattenExposed exposed)

427 let exposedDict = Map.fromKeys (\_ -> ()) (Outline.flattenExposed exposed)

453− docsStatus <- getDocsStatus cache pkg vsn

454 mvar <- newEmptyMVar

428 mvar <- newEmptyMVar

455− mvars <- Map.traverseWithKey (const . fork . crawlModule foreignDeps mvar pkg src docsStatus) exposedDict

429+ mvars <- Map.traverseWithKey (const . fork . crawlModule foreignDeps mvar pkg src) exposedDict

456 putMVar mvar mvars

430 putMVar mvar mvars

457 mapM_ readMVar mvars

431 mapM_ readMVar mvars

458 maybeStatuses <- traverse readMVar =<< readMVar mvar

432 maybeStatuses <- traverse readMVar =<< readMVar mvar

459 case sequence maybeStatuses of

433 case sequence maybeStatuses of

460 Nothing ->

434 Nothing ->

461 do Reporting.report key Reporting.DBroken

435 do Reporting.report key Reporting.DBroken

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

436+ return (Left BadBuild)

463

437

464 Just statuses ->

438 Just statuses ->

465 do rmvar <- newEmptyMVar

439 do rmvar <- newEmptyMVar

@@ -469,7 +443,7 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs =

469 case sequence maybeResults of

443 case sequence maybeResults of

470 Nothing ->

444 Nothing ->

471 do Reporting.report key Reporting.DBroken

445 do Reporting.report key Reporting.DBroken

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

446+ return (Left BadBuild)

473

447

474 Just results ->

448 Just results ->

475 let

449 let

@@ -477,10 +451,8 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs =

477 ifaces = gatherInterfaces exposedDict results

451 ifaces = gatherInterfaces exposedDict results

478 objects = gatherObjects results

452 objects = gatherObjects results

479 artifacts = Artifacts ifaces objects

453 artifacts = Artifacts ifaces objects

480− fingerprints = Set.insert f fs

481 in

454 in

482− do writeDocs cache pkg vsn docsStatus results

483− File.writeBinary path (ArtifactCache fingerprints artifacts)

455+ do File.writeBinary path (ArtifactCache fingerprints artifacts)

484 Reporting.report key Reporting.DBuilt

456 Reporting.report key Reporting.DBuilt

485 return (Right artifacts)

457 return (Right artifacts)

486

458

@@ -497,7 +469,7 @@ gatherObjects results =

497addLocalGraph :: ModuleName.Raw -> Result -> Opt.GlobalGraph -> Opt.GlobalGraph

469addLocalGraph :: ModuleName.Raw -> Result -> Opt.GlobalGraph -> Opt.GlobalGraph

498addLocalGraph name status graph =

470addLocalGraph name status graph =

499 case status of

471 case status of

500− RLocal _ objs _ -> Opt.addLocalGraph objs graph

472+ RLocal _ objs -> Opt.addLocalGraph objs graph

501 RForeign _ -> graph

473 RForeign _ -> graph

502 RKernelLocal cs -> Opt.addKernel (Name.getKernel name) cs graph

474 RKernelLocal cs -> Opt.addKernel (Name.getKernel name) cs graph

503 RKernelForeign -> graph

475 RKernelForeign -> graph

@@ -516,10 +488,10 @@ gatherInterfaces exposed artifacts =

516toLocalInterface :: (I.Interface -> a) -> Result -> Maybe a

488toLocalInterface :: (I.Interface -> a) -> Result -> Maybe a

517toLocalInterface func result =

489toLocalInterface func result =

518 case result of

490 case result of

519− RLocal iface _ _ -> Just (func iface)

491+ RLocal iface _ -> Just (func iface)

520− RForeign _ -> Nothing

492+ RForeign _ -> Nothing

521− RKernelLocal _ -> Nothing

493+ RKernelLocal _ -> Nothing

522− RKernelForeign -> Nothing

494+ RKernelForeign -> Nothing

523

495

524

496

525

497

@@ -562,14 +534,14 @@ type StatusDict =

562

534

563

535

564data Status

536data Status

565− = SLocal DocsStatus (Map.Map ModuleName.Raw ()) Src.Module

537+ = SLocal (Map.Map ModuleName.Raw ()) Src.Module

566 | SForeign I.Interface

538 | SForeign I.Interface

567 | SKernelLocal [Kernel.Chunk]

539 | SKernelLocal [Kernel.Chunk]

568 | SKernelForeign

540 | SKernelForeign

569

541

570

542

571−crawlModule :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> IO (Maybe Status)

543+crawlModule :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> ModuleName.Raw -> IO (Maybe Status)

572−crawlModule foreignDeps mvar pkg src docsStatus name =

544+crawlModule foreignDeps mvar pkg src name =

573 do let path = src </> ModuleName.toFilePath name <.> "elm"

545 do let path = src </> ModuleName.toFilePath name <.> "elm"

574 exists <- File.exists path

546 exists <- File.exists path

575 case Map.lookup name foreignDeps of

547 case Map.lookup name foreignDeps of

@@ -583,7 +555,7 @@ crawlModule foreignDeps mvar pkg src docsStatus name =

583

555

584 Nothing ->

556 Nothing ->

585 if exists then

557 if exists then

586− crawlFile foreignDeps mvar pkg src docsStatus name path

558+ crawlFile foreignDeps mvar pkg src name path

587

559

588 else if Pkg.isKernel pkg && Name.isKernel name then

560 else if Pkg.isKernel pkg && Name.isKernel name then

589 crawlKernel foreignDeps mvar pkg src name

561 crawlKernel foreignDeps mvar pkg src name

@@ -592,13 +564,13 @@ crawlModule foreignDeps mvar pkg src docsStatus name =

592 return Nothing

564 return Nothing

593

565

594

566

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

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

596−crawlFile foreignDeps mvar pkg src docsStatus expectedName path =

568+crawlFile foreignDeps mvar pkg src expectedName path =

597 do bytes <- File.readUtf8 path

569 do bytes <- File.readUtf8 path

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

570+ case Parse.fromByteString pkg bytes of

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

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

600 do deps <- crawlImports foreignDeps mvar pkg src imports

572 do deps <- crawlImports foreignDeps mvar pkg src imports

601− return (Just (SLocal docsStatus deps modul))

573+ return (Just (SLocal deps modul))

602

574

603 _ ->

575 _ ->

604 return Nothing

576 return Nothing

@@ -609,7 +581,7 @@ crawlImports foreignDeps mvar pkg src imports =

609 do statusDict <- takeMVar mvar

581 do statusDict <- takeMVar mvar

610 let deps = Map.fromList (map (\i -> (Src.getImportName i, ())) imports)

582 let deps = Map.fromList (map (\i -> (Src.getImportName i, ())) imports)

611 let news = Map.difference deps statusDict

583 let news = Map.difference deps statusDict

612− mvars <- Map.traverseWithKey (const . fork . crawlModule foreignDeps mvar pkg src DocsNotNeeded) news

584+ mvars <- Map.traverseWithKey (const . fork . crawlModule foreignDeps mvar pkg src) news

613 putMVar mvar (Map.union mvars statusDict)

585 putMVar mvar (Map.union mvars statusDict)

614 mapM_ readMVar mvars

586 mapM_ readMVar mvars

615 return deps

587 return deps

@@ -645,7 +617,7 @@ getDepHome fi =

645

617

646

618

647data Result

619data Result

648− = RLocal !I.Interface !Opt.LocalGraph (Maybe Docs.Module)

620+ = RLocal !I.Interface !Opt.LocalGraph

649 | RForeign I.Interface

621 | RForeign I.Interface

650 | RKernelLocal [Kernel.Chunk]

622 | RKernelLocal [Kernel.Chunk]

651 | RKernelForeign

623 | RKernelForeign

@@ -654,7 +626,7 @@ data Result

654compile :: Pkg.Name -> MVar (Map.Map ModuleName.Raw (MVar (Maybe Result))) -> Status -> IO (Maybe Result)

626compile :: Pkg.Name -> MVar (Map.Map ModuleName.Raw (MVar (Maybe Result))) -> Status -> IO (Maybe Result)

655compile pkg mvar status =

627compile pkg mvar status =

656 case status of

628 case status of

657− SLocal docsStatus deps modul ->

629+ SLocal deps modul ->

658 do resultsDict <- readMVar mvar

630 do resultsDict <- readMVar mvar

659 maybeResults <- traverse readMVar (Map.intersection resultsDict deps)

631 maybeResults <- traverse readMVar (Map.intersection resultsDict deps)

660 case sequence maybeResults of

632 case sequence maybeResults of

@@ -667,11 +639,7 @@ compile pkg mvar status =

667 return Nothing

639 return Nothing

668

640

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

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

670− let

671− ifaces = I.fromModule pkg canonical annotations

642+ return (Just (RLocal (I.fromModule pkg canonical annotations) objects))

672− docs = makeDocs docsStatus canonical

673− in

674− return (Just (RLocal ifaces objects docs))

675

643

676 SForeign iface ->

644 SForeign iface ->

677 return (Just (RForeign iface))

645 return (Just (RForeign iface))

@@ -686,59 +654,10 @@ compile pkg mvar status =

686getInterface :: Result -> Maybe I.Interface

654getInterface :: Result -> Maybe I.Interface

687getInterface result =

655getInterface result =

688 case result of

656 case result of

689− RLocal iface _ _ -> Just iface

657+ RLocal iface _ -> Just iface

690− RForeign iface -> Just iface

658+ RForeign iface -> Just iface

691− RKernelLocal _ -> Nothing

659+ RKernelLocal _ -> Nothing

692− RKernelForeign -> Nothing

660+ RKernelForeign -> Nothing

693−

694−

695−

696−-- MAKE DOCS

697−

698−

699−data DocsStatus

700− = DocsNeeded

701− | DocsNotNeeded

702−

703−

704−getDocsStatus :: Stuff.PackageCache -> Pkg.Name -> V.Version -> IO DocsStatus

705−getDocsStatus cache pkg vsn =

706− do exists <- File.exists (Stuff.package cache pkg vsn </> "docs.json")

707− if exists

708− then return DocsNotNeeded

709− else return DocsNeeded

710−

711−

712−makeDocs :: DocsStatus -> Can.Module -> Maybe Docs.Module

713−makeDocs status modul =

714− case status of

715− DocsNeeded ->

716− case Docs.fromModule modul of

717− Right docs -> Just docs

718− Left _ -> Nothing

719−

720− DocsNotNeeded ->

721− Nothing

722−

723−

724−writeDocs :: Stuff.PackageCache -> Pkg.Name -> V.Version -> DocsStatus -> Map.Map ModuleName.Raw Result -> IO ()

725−writeDocs cache pkg vsn status results =

726− case status of

727− DocsNeeded ->

728− E.writeUgly (Stuff.package cache pkg vsn </> "docs.json") $

729− Docs.encode $ Map.mapMaybe toDocs results

730−

731− DocsNotNeeded ->

732− return ()

733−

734−

735−toDocs :: Result -> Maybe Docs.Module

736−toDocs result =

737− case result of

738− RLocal _ _ docs -> docs

739− RForeign _ -> Nothing

740− RKernelLocal _ -> Nothing

741− RKernelForeign -> Nothing

742

661

743

662

744

663

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

747

666

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

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

749downloadPackage cache manager pkg vsn =

668downloadPackage cache manager pkg vsn =

750− let

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

752− in

753 do eitherByteString <-

669 do eitherByteString <-

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

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

755

671

756 case eitherByteString of

672 case eitherByteString of

757 Left err ->

673 Left err ->

758− return $ Left $ Exit.PP_BadEndpointRequest err

674+ return (Left (Exit.PP_BadEndpointRequest err))

759

675

760 Right byteString ->

676 Right byteString ->

761 case D.fromByteString endpointDecoder byteString of

677 case D.fromByteString endpointDecoder byteString of

762 Left _ ->

678 Left _ ->

763− return $ Left $ Exit.PP_BadEndpointContent url

679+ return (Left Exit.PP_BadEndpointContent)

764

680

765 Right (endpoint, expectedHash) ->

681 Right (endpoint, expectedHash) ->

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

682+ Http.getArchive manager endpoint Exit.PP_BadArchiveRequest Exit.PP_BadArchiveContent $

767 \(sha, archive) ->

683 \(sha, archive) ->

768 if expectedHash == Http.shaToChars sha

684 if expectedHash == Http.shaToChars sha

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

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

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

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

771

687

772

688

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

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

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

782

698

783

699

784instance Binary Details where

700instance Binary Details where

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

786− get =

787− do a <- get

788− b <- get

789− c <- get

790− d <- get

791− e <- get

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

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

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

793

703

794

704

795instance Binary ValidOutline where

705instance Binary ValidOutline where

796 put outline =

706 put outline =

797 case outline of

707 case outline of

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

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

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

709+ ValidPkg a b -> putWord8 1 >> put a >> put b

800

710

801 get =

711 get =

802 do n <- getWord8

712 do n <- getWord8

803 case n of

713 case n of

804 0 -> liftM ValidApp get

714 0 -> liftM ValidApp get

805− 1 -> liftM3 ValidPkg get get get

715+ 1 -> liftM2 ValidPkg get get

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

716+ _ -> error "binary encoding of ValidOutline was corrupted"

807

717

808

718

809instance Binary Local where

719instance Binary Local where

720+ get = liftM4 Local get get get get

810− put (Local a b c d e f) = put a >> put b >> put c >> put d >> put e >> put f

721+ put (Local a b c d) = put a >> put b >> put c >> put d

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)

819

722

820

723

821instance Binary Foreign where

724instance Binary Foreign where

builder/src/Elm/Diff.hsnew file+284

@@ -0,0 +1,284 @@

1+{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+module Elm.Diff

4+ ( Args(..)

5+ , diff

6+ )

7+ where

10+import Control.Monad.Except (liftIO)

11+import qualified Data.List as List

12+import qualified Data.Map as Map

13+import qualified Data.Maybe as Maybe

14+import qualified Data.Name as Name

15+

16+import qualified Deps.Cache as Cache

17+import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..), Magnitude(..))

18+import qualified Deps.Diff as Diff

19+import qualified Elm.Compiler.Type as Type

20+import qualified Elm.Docs as Docs

21+import qualified Elm.ModuleName as ModuleName

22+import qualified Elm.Package as Pkg

23+import qualified Elm.Project as Project

24+import qualified Elm.Project.Json as Project

25+import qualified Elm.Project.Summary as Summary

26+import qualified Elm.Version as V

27+import Reporting.Doc ((<>), (<+>))

28+import qualified Reporting.Doc as D

29+import qualified Reporting.Exit as Exit

30+import qualified Reporting.Exit.Diff as E

31+import qualified Reporting.Exit.Help as Help

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

33+import qualified Reporting.Task as Task

34+

35+

36+

37+-- DIFF

38+

39+

40+data Args

41+ = CodeVsLatest

42+ | CodeVsExactly V.Version

43+ | LocalInquiry V.Version V.Version

44+ | GlobalInquiry Pkg.Name V.Version V.Version

45+

46+

47+diff :: Args -> Task.Task ()

48+diff args =

49+ case args of

50+ GlobalInquiry name v1 v2 ->

51+ do registry <- Cache.mandatoryUpdate

52+ case Cache.getVersions name registry of

53+ Left suggestions ->

54+ throw $ E.UnknownPackage name suggestions

55+

56+ Right vsns ->

57+ do oldDocs <- getDocs name vsns (min v1 v2)

58+ newDocs <- getDocs name vsns (max v1 v2)

59+ writeDiff oldDocs newDocs

60+

61+ LocalInquiry v1 v2 ->

62+ do (_, name, vsns) <- getPackageInfo

63+ oldDocs <- getDocs name vsns (min v1 v2)

64+ newDocs <- getDocs name vsns (max v1 v2)

65+ writeDiff oldDocs newDocs

66+

67+ CodeVsLatest ->

68+ do (summary, name, vsns) <- getPackageInfo

69+ oldDocs <- getDocs name vsns (maximum vsns)

70+ newDocs <- Task.silently (error "TODO Project.generateDocs summary" summary)

71+ writeDiff oldDocs newDocs

72+

73+ CodeVsExactly version ->

74+ do (summary, name, vsns) <- getPackageInfo

75+ oldDocs <- getDocs name vsns version

76+ newDocs <- Task.silently (error "TODO Project.generateDocs summary" summary)

77+ writeDiff oldDocs newDocs

78+

79+

80+throw :: E.Exit -> Task.Task a

81+throw exit =

82+ Task.throw $ Exit.Diff exit

83+

84+

85+

86+-- DIFF HELPERS

87+

88+

89+getDocs :: Pkg.Name -> [V.Version] -> V.Version -> Task.Task Docs.Documentation

90+getDocs name allVersions version =

91+ if elem version allVersions then

92+ Cache.getDocs name version

93+ else

94+ throw $ E.UnknownVersion name version allVersions

95+

96+

97+getPackageInfo :: Task.Task (Summary.Summary, Pkg.Name, [V.Version])

98+getPackageInfo =

99+ do summary <- Project.getRoot

100+ case Summary._project summary of

101+ Project.App _ ->

102+ throw $ E.Application

103+

104+ Project.Pkg (Project.PkgInfo name _ _ _ _ _ _ _) ->

105+ do registry <- Cache.mandatoryUpdate

106+ case Cache.getVersions name registry of

107+ Right vsns ->

108+ return ( summary, name, vsns )

109+

110+ Left _ ->

111+ throw E.Unpublished

112+

113+

114+

115+-- WRITE DOC

116+

117+

118+writeDiff :: Docs.Documentation -> Docs.Documentation -> Task.Task ()

119+writeDiff oldDocs newDocs =

120+ let

121+ changes = Diff.diff oldDocs newDocs

122+ localizer = L.fromNames (Map.union oldDocs newDocs)

123+ in

124+ liftIO $ Help.toStdout (toDoc localizer changes <> "\n")

125+

126+

127+

128+-- TO DOC

129+

130+

131+toDoc :: L.Localizer -> PackageChanges -> D.Doc

132+toDoc localizer changes@(PackageChanges added changed removed) =

133+ if null added && Map.null changed && null removed then

134+ "No API changes detected, so this is a" <+> D.green "PATCH" <+> "change."

135+ else

136+ let

137+ magDoc =

138+ D.fromChars (Diff.magnitudeToString (Diff.toMagnitude changes))

139+

140+ header =

141+ "This is a" <+> D.green magDoc <+> "change."

142+

143+ addedChunk =

144+ if null added then [] else

145+ [ Chunk "ADDED MODULES" MINOR $

146+ D.vcat $ map (D.fromUtf8 . ModuleName.nameToString) added

147+ ]

148+

149+ removedChunk =

150+ if null removed then [] else

151+ [ Chunk "REMOVED MODULES" MAJOR $

152+ D.vcat $ map (D.fromUtf8 . ModuleName.nameToString) removed

153+ ]

154+

155+ chunks =

156+ addedChunk ++ removedChunk ++ map (changesToChunk localizer) (Map.toList changed)

157+ in

158+ D.vcat (header : "" : map chunkToDoc chunks)

159+

160+

161+data Chunk =

162+ Chunk

163+ { _title :: String

164+ , _magnitude :: Magnitude

165+ , _details :: D.Doc

166+ }

167+

168+

169+chunkToDoc :: Chunk -> D.Doc

170+chunkToDoc (Chunk title magnitude details) =

171+ let

172+ magDoc =

173+ Diff.magnitudeToString magnitude

174+

175+ header =

176+ "----" <+> D.fromChars title <+> "-" <+> D.fromChars magDoc <+> "----"

177+ in

178+ D.vcat

179+ [ D.dullcyan header

180+ , ""

181+ , D.indent 4 details

182+ , ""

183+ , ""

184+ ]

185+

186+

187+changesToChunk :: L.Localizer -> (Name.Name, ModuleChanges) -> Chunk

188+changesToChunk localizer (name, changes@(ModuleChanges unions aliases values binops)) =

189+ let

190+ magnitude =

191+ Diff.moduleChangeMagnitude changes

192+

193+ (unionAdd, unionChange, unionRemove) =

194+ changesToDocTriple (unionToDoc localizer) unions

195+

196+ (aliasAdd, aliasChange, aliasRemove) =

197+ changesToDocTriple (aliasToDoc localizer) aliases

198+

199+ (valueAdd, valueChange, valueRemove) =

200+ changesToDocTriple (valueToDoc localizer) values

201+

202+ (binopAdd, binopChange, binopRemove) =

203+ changesToDocTriple (binopToDoc localizer) binops

204+ in

205+ Chunk (Name.toChars name) magnitude $

206+ D.vcat $ List.intersperse "" $ Maybe.catMaybes $

207+ [ changesToDoc "Added" unionAdd aliasAdd valueAdd binopAdd

208+ , changesToDoc "Removed" unionRemove aliasRemove valueRemove binopRemove

209+ , changesToDoc "Changed" unionChange aliasChange valueChange binopChange

210+ ]

211+

212+

213+changesToDocTriple :: (k -> v -> D.Doc) -> Changes k v -> ([D.Doc], [D.Doc], [D.Doc])

214+changesToDocTriple entryToDoc (Changes added changed removed) =

215+ let

216+ indented (name, value) =

217+ D.indent 4 (entryToDoc name value)

218+

219+ diffed (name, (oldValue, newValue)) =

220+ D.vcat

221+ [ " - " <> entryToDoc name oldValue

222+ , " + " <> entryToDoc name newValue

223+ , ""

224+ ]

225+ in

226+ ( map indented (Map.toList added)

227+ , map diffed (Map.toList changed)

228+ , map indented (Map.toList removed)

229+ )

230+

231+

232+changesToDoc :: String -> [D.Doc] -> [D.Doc] -> [D.Doc] -> [D.Doc] -> Maybe D.Doc

233+changesToDoc categoryName unions aliases values binops =

234+ if null unions && null aliases && null values && null binops then

235+ Nothing

236+

237+ else

238+ Just $ D.vcat $

239+ D.fromChars categoryName <> ":" : unions ++ aliases ++ binops ++ values

240+

241+

242+unionToDoc :: L.Localizer -> Name.Name -> Docs.Union -> D.Doc

243+unionToDoc localizer name (Docs.Union _ tvars ctors) =

244+ let

245+ setup =

246+ "type" <+> D.fromName name <+> D.hsep (map D.fromName tvars)

247+

248+ ctorDoc (ctor, tipes) =

249+ typeDoc localizer (Type.Type ctor tipes)

250+ in

251+ D.hang 4 (D.sep (setup : zipWith (<+>) ("=" : repeat "|") (map ctorDoc ctors)))

252+

253+

254+aliasToDoc :: L.Localizer -> Name.Name -> Docs.Alias -> D.Doc

255+aliasToDoc localizer name (Docs.Alias _ tvars tipe) =

256+ let

257+ declaration =

258+ "type" <+> "alias" <+> D.hsep (map D.fromName (name:tvars)) <+> "="

259+ in

260+ D.hang 4 (D.sep [ declaration, typeDoc localizer tipe ])

261+

262+

263+valueToDoc :: L.Localizer -> Name.Name -> Docs.Value -> D.Doc

264+valueToDoc localizer name (Docs.Value _ tipe) =

265+ D.hang 4 $ D.sep [ D.fromName name <+> ":", typeDoc localizer tipe ]

266+

267+

268+binopToDoc :: L.Localizer -> Name.Name -> Docs.Binop -> D.Doc

269+binopToDoc localizer name (Docs.Binop _ tipe associativity (Docs.Precedence n)) =

270+ "(" <> D.fromName name <> ")" <+> ":" <+> typeDoc localizer tipe <> D.black details

271+ where

272+ details =

273+ " (" <> D.fromName assoc <> "/" <> D.fromInt n <> ")"

274+

275+ assoc =

276+ case associativity of

277+ Docs.Left -> "left"

278+ Docs.Non -> "non"

279+ Docs.Right -> "right"

280+

281+

282+typeDoc :: L.Localizer -> Type.Type -> D.Doc

283+typeDoc localizer tipe =

284+ Type.toDoc localizer Type.None tipe

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

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

5 , AppOutline(..)

6 , PkgOutline(..)

7 , Exposed(..)

8− , SrcDir(..)

9 , read

8 , read

10 , write

9 , write

11 , encode

10 , encode

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

19import Prelude hiding (read)

18import Prelude hiding (read)

20−import Control.Monad (filterM, liftM)

19+import Control.Monad (filterM)

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

22import qualified Data.Map as Map

20import qualified Data.Map as Map

23import qualified Data.NonEmptyList as NE

21import qualified Data.NonEmptyList as NE

24−import qualified Data.OneOrMore as OneOrMore

25import Foreign.Ptr (minusPtr)

22import Foreign.Ptr (minusPtr)

26import qualified System.Directory as Dir

23import qualified System.Directory as Dir

27−import qualified System.FilePath as FP

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

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

30import qualified Elm.Constraint as Con

26import qualified Elm.Constraint as Con

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

53data AppOutline =

49data AppOutline =

54 AppOutline

50 AppOutline

55 { _app_elm_version :: V.Version

51 { _app_elm_version :: V.Version

56− , _app_source_dirs :: NE.List SrcDir

52+ , _app_source_dirs :: NE.List FilePath

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

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

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

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

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

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

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

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

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

82−data SrcDir

83− = AbsoluteSrcDir FilePath

84− | RelativeSrcDir FilePath

85−

86−

88-- DEFAULTS

79-- DEFAULTS

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

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

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

127 E.object

118 E.object

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

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

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

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

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

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

131 , "dependencies" ==>

122 , "dependencies" ==>

132 E.object

123 E.object

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

174 E.dict Pkg.toJsonString encodeValue deps

165 E.dict Pkg.toJsonString encodeValue deps

175

166

176

167

177−encodeSrcDir :: SrcDir -> E.Value

178−encodeSrcDir srcDir =

179− case srcDir of

180− AbsoluteSrcDir dir -> E.chars dir

181− RelativeSrcDir dir -> E.chars dir

182−

183−

184

168

185-- PARSE AND VERIFY

169-- PARSE AND VERIFY

186

170

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

194

178

195 Right outline ->

179 Right outline ->

196 case outline of

180 case outline of

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

181+ Pkg _ ->

198− return $

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

200− then Left Exit.OutlineNoPkgCore

201− else Right outline

182+ return $ 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

236

183

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)

237

189

238−toAbsolute :: FilePath -> SrcDir -> FilePath

239−toAbsolute root srcDir =

240− case srcDir of

241− AbsoluteSrcDir dir -> dir

242− RelativeSrcDir dir -> root </> dir

243

190

244−

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

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

192+isBadSrcDir root dir =

246−detectDuplicates root srcDirs =

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

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

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

249− Map.fromListWith OneOrMore.more pairs

250−

251−

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

253−toPair root srcDir =

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

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

256−

257−

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

259−isDup paths =

260− case paths of

261− OneOrMore.One _ -> Nothing

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

263

194

264

195

265

196

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

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

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

338

269

339

270

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

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

341dirsDecoder =

272dirsDecoder =

342− fmap (toSrcDir . Json.toChars) <$> D.nonEmptyList D.string Exit.OP_NoSrcDirs

273+ fmap Json.toChars <$> D.nonEmptyList D.string Exit.OP_NoSrcDirs

343−

344−

345−toSrcDir :: FilePath -> SrcDir

346−toSrcDir path =

347− if FP.isRelative path

348− then RelativeSrcDir path

349− else AbsoluteSrcDir path

350

274

351

275

352

276

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

387 if len < bound

311 if len < bound

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

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

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

313 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/Elm/Publish.hsnew file+255

@@ -0,0 +1,255 @@

1+{-# OPTIONS_GHC -Wall #-}

2+module Elm.Publish (publish) where

5+import Control.Monad (when)

6+import Control.Monad.Except (catchError, runExceptT)

7+import Control.Monad.Trans (liftIO, lift)

8+import qualified Data.List as List

9+import qualified Data.Utf8 as Utf8

10+import qualified System.Directory as Dir

11+import qualified System.Exit as Exit

12+import System.FilePath ((</>))

13+import qualified System.IO as IO

14+import qualified System.Process as Process

15+

16+import qualified Deps.Cache as Cache

17+import qualified Deps.Diff as Diff

18+import qualified Deps.Website as Website

19+import qualified Elm.Bump as Bump

20+import qualified Elm.Docs as Docs

21+import qualified Elm.Package as Pkg

22+import qualified Elm.Project.Json as Project

23+import qualified Elm.Project.Summary as Summary

24+import qualified Elm.Version as V

25+import qualified Reporting.Exit as Exit

26+import qualified Reporting.Exit.Publish as E

27+import qualified Reporting.Progress as Progress

28+import qualified Reporting.Task as Task

29+import qualified Stuff.Paths as Path

30+

31+

32+

33+-- PUBLISH

34+

35+

36+publish :: Summary.Summary -> Task.Task ()

37+publish summary@(Summary.Summary root project _ _ _) =

38+ case project of

39+ Project.App _ ->

40+ throw E.Application

41+

42+ Project.Pkg (Project.PkgInfo name smry _ version exposed _ _ _) ->

43+ do

44+ registry <- Cache.mandatoryUpdate

45+ let maybePublishedVersions = either (const Nothing) Just (Cache.getVersions name registry)

46+

47+ Task.report (Progress.PublishStart name version maybePublishedVersions)

48+

49+ when (noExposed exposed) $ throw E.NoExposed

50+ when (badSummary smry) $ throw E.NoSummary

51+

52+ verifyReadme root

53+ verifyLicense root

54+ docs <- Task.silently (error "TODO Project.generateDocs summary" summary)

55+ verifyVersion name version docs maybePublishedVersions

56+ commitHash <- verifyTag name version

57+ verifyNoChanges commitHash version

58+ zipHash <- verifyZip name version

59+

60+ Website.register name version commitHash zipHash

61+

62+ Task.report Progress.PublishEnd

63+

64+

65+throw :: E.Exit -> Task.Task a

66+throw exit =

67+ Task.throw (Exit.Publish exit)

68+

69+

70+

71+-- VERIFY SUMMARY

72+

73+

74+badSummary :: Utf8.String -> Bool

75+badSummary summary =

76+ Utf8.isEmpty summary || Project.defaultSummary == summary

77+

78+

79+noExposed :: Project.Exposed -> Bool

80+noExposed exposed =

81+ case exposed of

82+ Project.ExposedList modules ->

83+ null modules

84+

85+ Project.ExposedDict chunks ->

86+ all (null . snd) chunks

87+

88+

89+

90+-- VERIFY README

91+

92+

93+verifyReadme :: FilePath -> Task.Task ()

94+verifyReadme root =

95+ phase Progress.CheckReadme $

96+ do let readmePath = root </> "README.md"

97+ exists <- liftIO $ Dir.doesFileExist readmePath

98+ case exists of

99+ False ->

100+ throw E.NoReadme

101+

102+ True ->

103+ do size <- liftIO $ IO.withFile readmePath IO.ReadMode IO.hFileSize

104+ if size < 300

105+ then throw E.ShortReadme

106+ else return ()

107+

108+

109+

110+-- VERIFY LICENSE

111+

112+

113+verifyLicense :: FilePath -> Task.Task ()

114+verifyLicense root =

115+ phase Progress.CheckLicense $

116+ do let licensePath = root </> "LICENSE"

117+ exists <- liftIO $ Dir.doesFileExist licensePath

118+ if exists

119+ then return ()

120+ else throw E.NoLicense

121+

122+

123+

124+-- VERIFY GITHUB TAG

125+

126+

127+verifyTag :: Pkg.Name -> V.Version -> Task.Task String

128+verifyTag name version =

129+ phase (Progress.CheckTag version) $

130+ Website.githubCommit name version `catchError` \_ ->

131+ throw (E.MissingTag version)

132+

133+

134+

135+-- VERIFY NO LOCAL CHANGES SINCE TAG

136+

137+

138+verifyNoChanges :: String -> V.Version -> Task.Task ()

139+verifyNoChanges commitHash version =

140+ phase Progress.CheckChanges $

141+ do maybeGit <- liftIO $ Dir.findExecutable "git"

142+ case maybeGit of

143+ Nothing ->

144+ throw E.NoGit

145+

146+ Just git ->

147+ do -- https://stackoverflow.com/questions/3878624/how-do-i-programmatically-determine-if-there-are-uncommited-changes

148+ exitCode <- liftIO $

149+ Process.rawSystem git [ "diff-index", "--quiet", commitHash, "--" ]

150+

151+ case exitCode of

152+ Exit.ExitSuccess ->

153+ return ()

154+

155+ Exit.ExitFailure _ ->

156+ throw (E.LocalChanges version)

157+

158+

159+

160+-- VERIFY THAT ZIP BUILDS / COMPUTE HASH

161+

162+

163+verifyZip :: Pkg.Name -> V.Version -> Task.Task Website.Sha

164+verifyZip name version =

165+ withTempDir $ \dir ->

166+ do hash <- phase Progress.CheckDownload $

167+ Website.githubDownload name version dir

168+

169+ phase Progress.CheckBuild $

170+ do runner <- Task.getSilentRunner

171+ result <- liftIO $ Dir.withCurrentDirectory dir $ runner $

172+ Task.silently $ error "TODO Project.generateDocs =<< Project.getRoot"

173+ either Task.throw (\_ -> return ()) result

174+

175+ return hash

176+

177+

178+withTempDir :: (FilePath -> Task.Task a) -> Task.Task a

179+withTempDir callback =

180+ do liftIO $ Dir.createDirectoryIfMissing True Path.prepublishDir

181+ result <- lift $ runExceptT $ callback Path.prepublishDir

182+ liftIO $ Dir.removeDirectoryRecursive Path.prepublishDir

183+ either Task.throw return result

184+

185+

186+

187+-- PHASE REPORTING

188+

189+

190+phase :: Progress.PublishPhase -> Task.Task a -> Task.Task a

191+phase publishPhase task =

192+ do Task.report $ Progress.PublishProgress publishPhase Nothing

193+

194+ result <- task `catchError` \exit ->

195+ do Task.report $ Progress.PublishProgress publishPhase (Just Progress.Bad)

196+ Task.throw exit

197+

198+ Task.report $ Progress.PublishProgress publishPhase (Just Progress.Good)

199+

200+ return result

201+

202+

203+

204+-- VERIFY VERSION

205+

206+

207+verifyVersion :: Pkg.Name -> V.Version -> Docs.Documentation -> Maybe [V.Version] -> Task.Task ()

208+verifyVersion name version docs maybePublishedVersions =

209+ let

210+ reportBumpPhase bumpPhase =

211+ Task.report $ Progress.PublishCheckBump version bumpPhase

212+ in

213+ do reportBumpPhase Progress.StatedVersion

214+ case maybePublishedVersions of

215+ Nothing ->

216+ if version == V.one then

217+ reportBumpPhase Progress.GoodStart

218+ else

219+ throw (E.NotInitialVersion version)

220+

221+ Just publishedVersions ->

222+ if elem version publishedVersions then

223+ throw $ E.AlreadyPublished version

224+ else

225+ do (old, magnitude) <- verifyBump name version docs publishedVersions

226+ reportBumpPhase (Progress.GoodBump old magnitude)

227+

228+ `catchError` \exit ->

229+ do reportBumpPhase Progress.BadBump

230+ Task.throw exit

231+

232+

233+verifyBump :: Pkg.Name -> V.Version -> Docs.Documentation -> [V.Version] -> Task.Task (V.Version, Diff.Magnitude)

234+verifyBump name statedVersion newDocs publishedVersions =

235+ let

236+ possibleBumps =

237+ Bump.toPossibleBumps publishedVersions

238+

239+ isTheBump (_ ,new, _) =

240+ statedVersion == new

241+ in

242+ case List.find isTheBump possibleBumps of

243+ Nothing ->

244+ throw $ E.InvalidBump statedVersion (last publishedVersions)

245+

246+ Just (old, new, magnitude) ->

247+ do oldDocs <- Cache.getDocs name old

248+ let changes = Diff.diff oldDocs newDocs

249+ let realNew = Diff.bump changes old

250+ if new == realNew

251+ then

252+ return (old, magnitude)

253+ else

254+ throw $ E.BadBump old new magnitude realNew $

255+ Diff.toMagnitude changes

builder/src/File.hs+5−28

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

1module File

2 ( Time

3 , getTime

4− , zeroTime

5 , writeBinary

4 , writeBinary

6 , readBinary

5 , readBinary

7 , writeUtf8

6 , writeUtf8

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

24import qualified Data.ByteString.Lazy as LBS

23import qualified Data.ByteString.Lazy as LBS

25import qualified Data.Fixed as Fixed

24import qualified Data.Fixed as Fixed

26import qualified Data.List as List

25import qualified Data.List as List

27−import qualified Data.Time.Clock as Time

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

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

29import qualified Foreign.ForeignPtr as FPtr

27import qualified Foreign.ForeignPtr as FPtr

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

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

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

46getTime :: FilePath -> IO Time

44getTime :: FilePath -> IO Time

47getTime path =

45getTime path =

48 fmap

46 fmap

47+ (Time . realToFrac . Time.utcTimeToPOSIXSeconds)

49− (Time . Time.nominalDiffTimeToSeconds . Time.utcTimeToPOSIXSeconds)

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

50 (Dir.getModificationTime path)

49 (Dir.getModificationTime path)

53−zeroTime :: Time

54−zeroTime =

55− Time 0

56−

57−

58instance Binary.Binary Time where

52instance Binary.Binary Time where

59 put (Time time) = Binary.put time

53 put (Time time) = Binary.put time

60 get = Time <$> Binary.get

54 get = Time <$> Binary.get

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

78 then

72 then

79 do result <- Binary.decodeFileOrFail path

73 do result <- Binary.decodeFileOrFail path

80 case result of

74 case result of

81− Right a ->

82− return (Just a)

75+ Right a -> 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

76+ Left e -> return Nothing

96 else

77 else

97 return Nothing

78 return Nothing

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

190 let

171 let

191 path = drop root (Zip.eRelativePath entry)

172 path = drop root (Zip.eRelativePath entry)

192 in

173 in

193− if List.isPrefixOf "src/" path

174+ if List.isPrefixOf "src/" path then

194− || path == "LICENSE"

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

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

197− then

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

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

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

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

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

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

builder/src/Generate.hsdeleted−211

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

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

@@ -16,7 +16,6 @@ module Http

16 -- upload

17 , upload

18 , filePart

19− , jsonPart

20 , stringPart

19 , stringPart

21 )

20 )

22 where

21 where

@@ -27,7 +26,6 @@ import qualified Codec.Archive.Zip as Zip

27import Control.Exception (SomeException, handle)

26import Control.Exception (SomeException, handle)

28import qualified Data.Binary as Binary

27import qualified Data.Binary as Binary

29import qualified Data.Binary.Get as Binary

28import qualified Data.Binary.Get as Binary

30−import qualified Data.ByteString.Builder as B

31import qualified Data.ByteString.Char8 as BS

29import qualified Data.ByteString.Char8 as BS

32import qualified Data.Digest.Pure.SHA as SHA

30import qualified Data.Digest.Pure.SHA as SHA

33import qualified Data.String as String

31import qualified Data.String as String

@@ -36,10 +34,8 @@ import Network.HTTP.Client

36import Network.HTTP.Client.TLS (tlsManagerSettings)

34import Network.HTTP.Client.TLS (tlsManagerSettings)

37import Network.HTTP.Types.Header (Header, hAccept, hAcceptEncoding, hUserAgent)

35import Network.HTTP.Types.Header (Header, hAccept, hAcceptEncoding, hUserAgent)

38import Network.HTTP.Types.Method (Method, methodGet, methodPost)

36import Network.HTTP.Types.Method (Method, methodGet, methodPost)

39−import qualified Network.HTTP.Client as Multi (RequestBody(RequestBodyLBS))

40import qualified Network.HTTP.Client.MultipartFormData as Multi

37import qualified Network.HTTP.Client.MultipartFormData as Multi

42−import qualified Json.Encode as Encode

43import qualified Elm.Version as V

39import qualified Elm.Version as V

@@ -230,15 +226,6 @@ filePart name filePath =

230 Multi.partFileSource (String.fromString name) filePath

226 Multi.partFileSource (String.fromString name) filePath

231

227

232

228

233−jsonPart :: String -> FilePath -> Encode.Value -> Multi.Part

234−jsonPart name filePath value =

235− let

236− body =

237− Multi.RequestBodyLBS $ B.toLazyByteString $ Encode.encodeUgly value

238− in

239− Multi.partFileRequestBody (String.fromString name) filePath body

240−

241−

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

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

243stringPart name string =

230stringPart name string =

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

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

builder/src/Reporting.hs+22−43

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

1{-# LANGUAGE BangPatterns, OverloadedStrings #-}

2module Reporting

3 ( Style

4− , silent

5 , json

4 , json

6 , terminal

5 , terminal

7 --

6 --

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

33import qualified Data.NonEmptyList as NE

32import qualified Data.NonEmptyList as NE

34import qualified System.Exit as Exit

33import qualified System.Exit as Exit

35import qualified System.Info as Info

34import qualified System.Info as Info

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

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

38import qualified Elm.ModuleName as ModuleName

37import qualified Elm.ModuleName as ModuleName

39import qualified Elm.Package as Pkg

38import qualified Elm.Package as Pkg

@@ -50,16 +49,10 @@ import qualified Reporting.Exit.Help as Help

52data Style

51data Style

53− = Silent

54− | Json

52+ = Json

55 | Terminal (MVar ())

53 | Terminal (MVar ())

58−silent :: Style

59−silent =

60− Silent

61−

62−

63json :: Style

56json :: Style

64json =

57json =

65 Json

58 Json

@@ -78,9 +71,7 @@ attempt :: (x -> Help.Report) -> IO (Either x a) -> IO a

78attempt toReport work =

71attempt toReport work =

79 do result <- work `catch` reportExceptionsNicely

72 do result <- work `catch` reportExceptionsNicely

80 case result of

73 case result of

81− Right a ->

82− return a

74+ Right a -> return a

83−

84 Left x ->

75 Left x ->

85 do Exit.toStderr (toReport x)

76 do Exit.toStderr (toReport x)

86 Exit.exitFailure

77 Exit.exitFailure

@@ -90,14 +81,9 @@ attemptWithStyle :: Style -> (x -> Help.Report) -> IO (Either x a) -> IO a

90attemptWithStyle style toReport work =

81attemptWithStyle style toReport work =

91 do result <- work `catch` reportExceptionsNicely

82 do result <- work `catch` reportExceptionsNicely

92 case result of

83 case result of

93− Right a ->

94− return a

84+ Right a -> return a

95−

96 Left x ->

85 Left x ->

97 case style of

86 case style of

98− Silent ->

99− do Exit.exitFailure

100−

101 Json ->

87 Json ->

102 do B.hPutBuilder stderr (Encode.encodeUgly (Exit.toJson (toReport x)))

88 do B.hPutBuilder stderr (Encode.encodeUgly (Exit.toJson (toReport x)))

103 Exit.exitFailure

89 Exit.exitFailure

@@ -122,6 +108,11 @@ badMark =

122 D.red $ if isWindows then "X" else "✗"

108 D.red $ if isWindows then "X" else "✗"

123

109

124

110

111+_waitingMark :: D.Doc

112+_waitingMark =

113+ D.dullyellow $ if isWindows then "-" else "→"

114+

115+

125isWindows :: Bool

116isWindows :: Bool

126isWindows =

117isWindows =

127 Info.os == "mingw32"

118 Info.os == "mingw32"

@@ -177,9 +168,6 @@ type DKey = Key DMsg

177trackDetails :: Style -> (DKey -> IO a) -> IO a

168trackDetails :: Style -> (DKey -> IO a) -> IO a

178trackDetails style callback =

169trackDetails style callback =

179 case style of

170 case style of

180− Silent ->

181− callback (Key (\_ -> return ()))

182−

183 Json ->

171 Json ->

184 callback (Key (\_ -> return ()))

172 callback (Key (\_ -> return ()))

185

173

@@ -264,8 +252,8 @@ putDownload :: D.Doc -> Pkg.Name -> V.Version -> IO ()

264putDownload mark pkg vsn =

252putDownload mark pkg vsn =

265 Help.toStdout $ D.indent 2 $

253 Help.toStdout $ D.indent 2 $

266 mark

254 mark

267− <+> D.fromPackage pkg

255+ <+> D.fromUtf8 (Pkg.toString pkg)

268− <+> D.fromVersion vsn

256+ <+> D.fromUtf8 (V.toString vsn)

269 <> "\n"

257 <> "\n"

270

258

271

259

@@ -309,9 +297,6 @@ type BResult a = Either Exit.BuildProblem a

309trackBuild :: Style -> (BKey -> IO (BResult a)) -> IO (BResult a)

297trackBuild :: Style -> (BKey -> IO (BResult a)) -> IO (BResult a)

310trackBuild style callback =

298trackBuild style callback =

311 case style of

299 case style of

312− Silent ->

313− callback (Key (\_ -> return ()))

314−

315 Json ->

300 Json ->

316 callback (Key (\_ -> return ()))

301 callback (Key (\_ -> return ()))

317

302

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

364

349

365 Left problem ->

350 Left problem ->

366 case problem of

351 case problem of

367− Exit.BuildBadModules _ _ [] ->

352+ Exit.BuildModuleProblems _ [] ->

368 "Detected problems in 1 module."

353 "Detected problems in 1 module."

369

354

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

355+ Exit.BuildModuleProblems _ (_:ps) ->

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

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

372

357

373 Exit.BuildProjectProblem _ ->

358 Exit.BuildProjectProblem _ ->

@@ -381,9 +366,6 @@ toFinalMessage done result =

381reportGenerate :: Style -> NE.List ModuleName.Raw -> FilePath -> IO ()

366reportGenerate :: Style -> NE.List ModuleName.Raw -> FilePath -> IO ()

382reportGenerate style names output =

367reportGenerate style names output =

383 case style of

368 case style of

384− Silent ->

385− return ()

386−

387 Json ->

369 Json ->

388 return ()

370 return ()

389

371

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

446

428

447

429

448putException :: SomeException -> IO ()

430putException :: SomeException -> IO ()

449−putException e = do

431+putException e =

450− hPutStrLn stderr ""

451 Help.toStderr $ D.stack $

432 Help.toStderr $ D.stack $

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

453− , D.reflow $

433+ [ D.reflow $

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

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

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

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

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

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

457 , D.reflow $

437 , D.reflow $

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

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

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

460− \ unstuck quickly."

439+ \ or Discourse to see if anyone can get you unstuck quickly."

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

440+ , "------------------------------------------------------------"

462 , D.reflow $

441 , D.reflow $

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

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

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

443+ \ smallest version that still triggers this message. Ideally in a single Main.elm\

465− \ elm.json file."

444+ \ and elm.json file."

466 , D.reflow $

445 , D.reflow $

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

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

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

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

builder/src/Reporting/Exit.hs+375−1616

@@ -1,27 +1,31 @@

1{-# LANGUAGE OverloadedStrings #-}

2module Reporting.Exit

3+ ( Exit(..)

4+ --

5+ , Init(..)

3− ( Init(..), initToReport

6+ , initToReport

7+ --

8+ , Diff(..)

4− , Diff(..), diffToReport

9+ , diffToReport

5− , Make(..), makeToReport

10+ --

6− , Bump(..), bumpToReport

11+ , Install(..)

7− , Repl(..), replToReport

8− , Publish(..), publishToReport

9− , Install(..), installToReport

12+ , installToReport

10− , Reactor(..), reactorToReport

11− , newPackageOverview

12 --

13 --

13 , Solver(..)

14 , Solver(..)

15+ --

14 , Outline(..)

16 , Outline(..)

15 , OutlineProblem(..)

17 , OutlineProblem(..)

18+ --

16 , Details(..)

19 , Details(..)

17− , DetailsBadDep(..)

18− , PackageProblem(..)

19 , RegistryProblem(..)

20 , RegistryProblem(..)

21+ , PackageProblem(..)

22+ --

23+ , Make(..)

20 , BuildProblem(..)

24 , BuildProblem(..)

21 , BuildProjectProblem(..)

25 , BuildProjectProblem(..)

22− , DocsProblem(..)

26+ , makeToReport

23− , Generate(..)

24 --

27 --

28+ , DocsProblem(..)

25 , toString

29 , toString

26 , toStderr

30 , toStderr

27 , toJson

31 , toJson

@@ -29,56 +33,61 @@ module Reporting.Exit

29 where

33 where

32−import qualified Data.ByteString as BS

33−import qualified Data.ByteString.UTF8 as BS_UTF8

34import qualified Data.List as List

36import qualified Data.List as List

35−import qualified Data.Map as Map

36−import qualified Data.Name as N

37import qualified Data.NonEmptyList as NE

38−import qualified Network.HTTP.Client as HTTP

38+import qualified Data.Utf8 as Utf8

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 ((</>), (<.>))

44import qualified Elm.Constraint as C

40import qualified Elm.Constraint as C

45import qualified Elm.Magnitude as M

41import qualified Elm.Magnitude as M

46import qualified Elm.ModuleName as ModuleName

42import qualified Elm.ModuleName as ModuleName

47import qualified Elm.Package as Pkg

43import qualified Elm.Package as Pkg

48import qualified Elm.Version as V

44import qualified Elm.Version as V

49−import qualified File

50import qualified Http

45import qualified Http

51−import qualified Json.Decode as Decode

52import qualified Json.Encode as Encode

46import qualified Json.Encode as Encode

53−import qualified Json.String as Json

54−import Parse.Primitives (Row, Col)

55−import qualified Reporting.Annotation as A

56import Reporting.Doc ((<>))

47import Reporting.Doc ((<>))

57import qualified Reporting.Doc as D

48import qualified Reporting.Doc as D

58import qualified Reporting.Error.Import as Import

49import qualified Reporting.Error.Import as Import

59import qualified Reporting.Error.Json as Json

50import qualified Reporting.Error.Json as Json

60import qualified Reporting.Exit.Help as Help

51import qualified Reporting.Exit.Help as Help

61import qualified Reporting.Error as Error

52import qualified Reporting.Error as Error

62−import qualified Reporting.Render.Code as Code

63−

64−

66−-- RENDERERS

69−toString :: Help.Report -> String

56+-- ALL POSSIBLE ERRORS

70−toString report =

71− Help.toString (Help.reportToDoc report)

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

59+data Exit

75−toStderr report =

60+ -- bump

76− Help.toStderr (Help.reportToDoc report)

61+ = BumpApplication

62+ | BumpUnexpectedVersion V.Version [V.Version]

63+ | BumpMustHaveLatestRegistry RegistryProblem

64+ | BumpCannotFindDocs Pkg.Name V.Version DocsProblem

65+ -- publish

66+ | PublishMustHaveLatestRegistry RegistryProblem

67+ | PublishApplication

68+ | PublishNotInitialVersion V.Version

69+ | PublishAlreadyPublished V.Version

70+ | PublishInvalidBump V.Version V.Version

71+ | PublishBadBump V.Version V.Version M.Magnitude V.Version M.Magnitude

72+ | PublishNoSummary

73+ | PublishNoExposed

74+ | PublishNoReadme

75+ | PublishShortReadme

76+ | PublishNoLicense

77+ | PublishCannotGetTag Http.Error

78+ | PublishCannotGetZip Http.Error

79+ | PublishCannotDecodeZip

80+ | PublishCannotGetDocs DocsProblem

81+ | PublishCannotRegister Http.Error

82+ | PublishMissingTag V.Version

83+ | PublishNoGit

84+ | PublishLocalChanges V.Version

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

87+data DocsProblem

80−toJson report =

88+ = DP_Http Http.Error

81− Help.reportToJson report

89+ | DP_Data

90+ | DP_Cache

@@ -109,18 +118,13 @@ initToReport exit =

109

118

110 InitNoOfflineSolution pkgs ->

119 InitNoOfflineSolution pkgs ->

111 Help.report "NO OFFLINE SOLUTION" Nothing

120 Help.report "NO OFFLINE SOLUTION" Nothing

112− "I tried to create an elm.json with the following direct dependencies:"

121+ (error "TODO InitNoOfflineSolution" pkgs)

113− [ D.indent 4 $ D.vcat $

122+ (error "TODO InitNoOfflineSolution" pkgs)

114− map (D.dullyellow . D.fromChars . Pkg.toChars) pkgs

123+ -- note about Russia IP addresses?

115− , D.reflow $

124+ -- ask if they are on a plane or train

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

121

125

122 InitSolverProblem solver ->

126 InitSolverProblem solver ->

123− toSolverReport solver

127+ error "TODO InitSolverProblem" solver

124

128

125 InitAlreadyExists ->

129 InitAlreadyExists ->

126 Help.report "EXISTING PROJECT" Nothing

130 Help.report "EXISTING PROJECT" Nothing

@@ -131,9 +135,8 @@ initToReport exit =

131 ]

135 ]

132 ]

136 ]

133

137

134− InitRegistryProblem problem ->

138+ InitRegistryProblem _ ->

135− toRegistryProblemReport "PROBLEM LOADING PACKAGE LIST" problem $

139+ error "TODO InitRegistryProblem"

136− "I need the list of published packages before I can start initializing projects"

137

140

138

141

139

142

@@ -141,48 +144,22 @@ initToReport exit =

141

144

142

145

143data Diff

146data Diff

144− = DiffNoOutline

145− | DiffBadOutline Outline

146− | DiffApplication

147+ = DiffApplication

147− | DiffNoExposed

148 | DiffUnpublished

149 | DiffUnknownPackage Pkg.Name [Pkg.Name]

150 | DiffUnknownVersion Pkg.Name V.Version [V.Version]

151− | DiffDocsProblem V.Version DocsProblem

151+ | DiffCannotFindDocs DocsProblem

152 | DiffMustHaveLatestRegistry RegistryProblem

153− | DiffBadDetails Details

154− | DiffBadBuild BuildProblem

155

153

156

154

157diffToReport :: Diff -> Help.Report

155diffToReport :: Diff -> Help.Report

158diffToReport diff =

156diffToReport diff =

159 case diff of

157 case diff of

160− DiffNoOutline ->

161− Help.report "DIFF WHAT?" Nothing

162− "I cannot find an elm.json so I am not sure what you want me to diff.\

163− \ Normally you run `elm diff` from within a project!"

164− [ D.reflow $ "If you are just curious to see a diff, try running this command:"

165− , D.indent 4 $ D.green $ "elm diff elm/http 1.0.0 2.0.0"

166− ]

167−

168− DiffBadOutline outline ->

169− toOutlineReport outline

170−

171 DiffApplication ->

158 DiffApplication ->

172− Help.report "CANNOT DIFF APPLICATIONS" (Just "elm.json")

159+ Help.report "CANNOT DIFF APPLICATIONS" Nothing

173− "Your elm.json says this project is an application, but `elm diff` only works\

160+ "I cannot perform diffs on applications, only packages! If you are\

174− \ with packages. That way there are previously published versions of the API to\

175− \ diff against!"

176− [ D.reflow $ "If you are just curious to see a diff, try running this command:"

161+ \ just curious to see a diff, try running this command:"

177− , D.indent 4 $ D.dullyellow $ "elm diff elm/json 1.0.0 1.1.2"

162+ [ D.indent 4 $ D.green $ "elm diff elm/html 5.1.1 6.0.0"

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."

186 ]

163 ]

187

164

188 DiffUnpublished ->

165 DiffUnpublished ->

@@ -194,16 +171,16 @@ diffToReport diff =

194 Help.report "UNKNOWN PACKAGE" Nothing

171 Help.report "UNKNOWN PACKAGE" Nothing

195 ( "I cannot find a package called:"

172 ( "I cannot find a package called:"

196 )

173 )

197− [ D.indent 4 $ D.red $ D.fromChars $ Pkg.toChars pkg

174+ [ D.indent 4 $ D.red $ D.fromUtf8 $ Pkg.toString pkg

198 , "Maybe you want one of these instead?"

175 , "Maybe you want one of these instead?"

199− , D.indent 4 $ D.dullyellow $ D.vcat $ map (D.fromChars . Pkg.toChars) suggestions

176+ , D.indent 4 $ D.dullyellow $ D.vcat $ map (D.fromUtf8 . Pkg.toString) suggestions

200 , "But check <https://package.elm-lang.org> to see all possibilities!"

177 , "But check <https://package.elm-lang.org> to see all possibilities!"

201 ]

178 ]

202

179

203 DiffUnknownVersion _pkg vsn realVersions ->

180 DiffUnknownVersion _pkg vsn realVersions ->

204 Help.docReport "UNKNOWN VERSION" Nothing

181 Help.docReport "UNKNOWN VERSION" Nothing

205 ( D.fillSep $

182 ( D.fillSep $

206− [ "Version", D.red (D.fromVersion vsn)

183+ [ "Version", D.red (D.fromUtf8 (V.toString vsn))

207 , "has", "never", "been", "published,", "so", "I"

184 , "has", "never", "been", "published,", "so", "I"

208 , "cannot", "diff", "against", "it."

185 , "cannot", "diff", "against", "it."

209 ]

186 ]

@@ -212,57 +189,232 @@ diffToReport diff =

212 , D.indent 4 $ D.dullyellow $ D.vcat $

189 , D.indent 4 $ D.dullyellow $ D.vcat $

213 let

190 let

214 sameMajor v1 v2 = V._major v1 == V._major v2

191 sameMajor v1 v2 = V._major v1 == V._major v2

215− mkRow vsns = D.hsep $ map D.fromVersion vsns

192+ mkRow vsns = D.hsep $ map (D.fromUtf8 . V.toString) vsns

216 in

193 in

217 map mkRow $ List.groupBy sameMajor (List.sort realVersions)

194 map mkRow $ List.groupBy sameMajor (List.sort realVersions)

218 , "Want one of those instead?"

195 , "Want one of those instead?"

219 ]

196 ]

220

197

221− DiffDocsProblem version problem ->

198+ DiffCannotFindDocs problem ->

222− toDocsProblemReport problem $

199+ error "TODO DiffCannotFindDocs" problem

223− "I need the docs for " ++ V.toChars version ++ " to compute this diff"

224

200

225 DiffMustHaveLatestRegistry problem ->

201 DiffMustHaveLatestRegistry problem ->

226− toRegistryProblemReport "PROBLEM UPDATING PACKAGE LIST" problem $

202+ error "TODO DiffMustHaveLatestRegistry" problem

227− "I need the latest list of published packages before I do this diff"

228

203

229− DiffBadDetails details ->

230− toDetailsReport details

231

204

232− DiffBadBuild buildProblem ->

233− toBuildProblemReport buildProblem

234

205

206+-- INSTALL

235

207

236

208

237−-- BUMP

209+data Install

210+ = InstallNoProject

211+ | InstallNoArgs FilePath

212+ | InstallNoOnlineSolution

213+ | InstallNoOfflineSolution

214+ | InstallHadSolverTrouble Solver

215+ | InstallUnknownPackageOnline [Pkg.Name]

216+ | InstallUnknownPackageOffline [Pkg.Name]

217+ | InstallHasBadDetails Details

238

218

239

219

240−data Bump

220+installToReport :: Install -> Help.Report

241− = BumpNoOutline

221+installToReport exit =

242− | BumpBadOutline Outline

222+ case exit of

243− | BumpApplication

223+ InstallNoProject ->

244− | BumpUnexpectedVersion V.Version [V.Version]

224+ Help.report "NEW PROJECT?" Nothing

245− | BumpMustHaveLatestRegistry RegistryProblem

225+ "Are you trying to start a new project? Try this command instead:"

246− | BumpCannotFindDocs Pkg.Name V.Version DocsProblem

226+ [ D.indent 4 $ D.green "elm init"

247− | BumpBadDetails Details

227+ , D.reflow "It will help you get started!"

248− | BumpNoExposed

228+ ]

249− | BumpBadBuild BuildProblem

250

229

230+ InstallNoArgs elmHome ->

231+ Help.report "INSTALL WHAT?" Nothing

232+ "I am expecting commands like:"

233+ [ D.green $ D.indent 4 $ D.vcat $

234+ [ "elm install elm/http"

235+ , "elm install elm/json"

236+ , "elm install elm/random"

237+ ]

238+ , D.toFancyHint

239+ ["In","JavaScript","folks","run","`npm install`","to","start","projects."

240+ ,"\"Gotta","download","everything!\"","But","why","download","packages"

241+ ,"again","and","again?","Instead,","Elm","caches","packages","in"

242+ ,D.dullyellow (D.fromChars elmHome)

243+ ,"so","each","one","is","downloaded","and","built","ONCE","on","your","machine."

244+ ,"Elm","projects","check","that","cache","before","trying","the","internet."

245+ ,"This","reduces","build","times,","reduces","server","costs,","and","makes","it"

246+ ,"easier","to","work","offline.","As","a","result"

247+ ,D.dullcyan "elm install","is","only","for","adding","dependencies","to","elm.json,"

248+ ,"whereas",D.dullcyan "elm make","is","in","charge","of","gathering","dependencies"

249+ ,"and","building","everything.","So","maybe","try",D.green "elm make","instead?"

250+ ]

251+ ]

251

252

252−bumpToReport :: Bump -> Help.Report

253+ InstallNoOnlineSolution ->

253−bumpToReport bump =

254+ Help.report "UNSOLVABLE DEPENDENCIES" (Just "elm.json") -- TODO recommend using solver in `elm reactor`

254− case bump of

255+ "This usually happens if you try to modify dependency constraints by\

255− BumpNoOutline ->

256+ \ hand. I recommend deleting any dependency you added recently (or all\

256− Help.report "BUMP WHAT?" Nothing

257+ \ of them if things are bad) and then adding them again with:"

257− "I cannot find an elm.json so I am not sure what you want me to bump."

258+ [ D.indent 4 $ D.green "elm install"

258− [ D.reflow $

259+ , D.reflow $

259− "Elm packages always have an elm.json that says current the version number. If\

260+ "And do not be afaid to ask for help on Slack if you get stuck!"

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 ]

261 ]

263

262

264− BumpBadOutline outline ->

263+ InstallNoOfflineSolution ->

265− toOutlineReport outline

264+ error "TODO InstallNoOfflineSolution"

265+

266+ InstallHadSolverTrouble solver ->

267+ error "TODO InstallHadSolverTrouble" solver

268+

269+ InstallUnknownPackageOnline suggestions ->

270+ error "TODO InstallUnknownPackageOnline" suggestions

271+

272+ InstallUnknownPackageOffline suggestions ->

273+ error "TODO InstallUnknownPackageOffline" suggestions

274+

275+ InstallHasBadDetails _ ->

276+ error "TODO InstallHasBadDetails"

277+

278+

279+{- TODO detect if library has no 0.19.0 version. Maybe do this on website though?

280+ Help.report "OLD DEPENDENCIES" (Just "elm.json")

281+ ( "The following packages do not work with Elm " ++ V.toChars V.compiler ++ " right now:"

282+ )

283+ [ D.indent 4 $ D.vcat $ map (D.red . D.fromUtf8 . Pkg.toString) badPackages

284+ , D.reflow $

285+ "This may be because it is not upgraded yet. It may be because a\

286+ \ better solution came along, so there was no need to upgrade it.\

287+ \ Etc. Try asking around on Slack to learn more about the topic."

288+ , D.toSimpleNote

289+ "Whatever the case, please be kind to the relevant package authors! Having\

290+ \ friendly interactions with users is great motivation, and conversely, getting\

291+ \ berated by strangers on the internet sucks your soul dry. Furthermore, package\

292+ \ authors are humans with families, friends, jobs, vacations, responsibilities,\

293+ \ goals, etc. They face obstacles outside of their technical work you will never\

294+ \ know about, so please assume the best and try to be patient and supportive!"

295+ ]

296+-}

297+

298+

299+

300+-- SOLVER

301+

302+

303+data Solver

304+ = SolverBadCacheData Pkg.Name V.Version

305+ | SolverBadHttpData Pkg.Name V.Version

306+ | SolverBadHttp Http.Error

307+

308+

309+

310+-- OUTLINE

311+

312+

313+data Outline

314+ = OutlineHasBadStructure (Json.Error OutlineProblem)

315+ | OutlineHasBadSrcDirs FilePath [FilePath]

316+

317+

318+data OutlineProblem

319+ = OP_BadType Utf8.String

320+ | OP_BadPkgName Pkg.BadName

321+ | OP_BadVersion Utf8.String

322+ | OP_BadConstraint C.Error

323+ | OP_BadModuleName Utf8.String

324+ | OP_BadModuleHeaderTooLong Utf8.String

325+ | OP_BadDependencyName Utf8.String

326+ | OP_BadLicense Utf8.String [Utf8.String]

327+ | OP_BadSummaryTooLong

328+ | OP_NoSrcDirs

329+

330+

331+

332+-- DETAILS

333+

334+

335+data Details

336+ = DetailsCorrupt

337+ | DetailsNoSolution

338+ | DetailsNoOfflineSolution

339+ | DetailsSolverProblem Solver

340+ | DetailsBadElmInPkg C.Constraint

341+ | DetailsBadElmInAppOutline V.Version

342+ | DetailsHandEditedDependencies

343+ | DetailsBadOutline Outline

344+ | DetailsCannotGetRegistry RegistryProblem

345+ | DetailsCannotBuildPackage Pkg.Name V.Version PackageProblem

346+

347+

348+data RegistryProblem

349+ = RP_Http Http.Error

350+ | RP_Data

351+

352+

353+data PackageProblem

354+ = PP_BadEndpointRequest Http.Error

355+ | PP_BadEndpointContent

356+ | PP_BadArchiveRequest Http.Error

357+ | PP_BadArchiveContent

358+ | PP_BadArchiveHash String String

359+

360+

361+

362+-- MAKE

363+

364+

365+data Make

366+ = MakeNeedsOutline

367+ | MakeCannotOptimizeAndDebug

368+ | MakeBlockedByDetailsProblem Details

369+ | MakeAppNeedsFileNames

370+ | MakePkgNeedsExposing

371+ | MakeMultipleFilesIntoHtml

372+ | MakeNonMainFilesIntoJavaScript ModuleName.Raw [ModuleName.Raw]

373+ | MakeCannotOptimizeDebugValues ModuleName.Raw [ModuleName.Raw]

374+ | MakeCannotBuild BuildProblem

375+ | MakeCannotLoadArtifacts

376+

377+

378+data BuildProblem

379+ = BuildModuleProblems Error.Module [Error.Module]

380+ | BuildProjectProblem BuildProjectProblem

381+

382+

383+data BuildProjectProblem

384+ = BP_PathUnknown FilePath

385+ | BP_WithBadExtension FilePath

386+ | BP_WithAmbiguousSrcDir FilePath FilePath

387+ | BP_MainPathDuplicate FilePath FilePath

388+ | BP_MainNameDuplicate ModuleName.Raw FilePath FilePath

389+ | BP_CannotLoadDependencies

390+ | BP_Cycle ModuleName.Raw [ModuleName.Raw]

391+ | BP_MissingExposed (NE.List (ModuleName.Raw, Import.Problem))

392+

393+

394+

395+-- RENDERERS

396+

397+

398+toString :: Help.Report -> String

399+toString report =

400+ Help.toString (Help.reportToDoc report)

401+

402+

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

404+toStderr report =

405+ Help.toStderr (Help.reportToDoc report)

406+

407+

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

409+toJson report =

410+ Help.reportToJson report

411+

412+

413+_toReport :: Exit -> Help.Report

414+_toReport exit =

415+ case exit of

416+

417+ -- bump

266

418

267 BumpApplication ->

419 BumpApplication ->

268 Help.report "CANNOT BUMP APPLICATIONS" (Just "elm.json")

420 Help.report "CANNOT BUMP APPLICATIONS" (Just "elm.json")

@@ -274,7 +426,7 @@ bumpToReport bump =

274 Help.docReport "CANNOT BUMP" (Just "elm.json")

426 Help.docReport "CANNOT BUMP" (Just "elm.json")

275 ( D.fillSep

427 ( D.fillSep

276 ["Your","elm.json","says","I","should","bump","relative","to","version"

428 ["Your","elm.json","says","I","should","bump","relative","to","version"

277− ,D.red (D.fromVersion vsn) <> ","

429+ ,D.red (D.fromUtf8 (V.toString vsn)) <> ","

278 ,"but","I","cannot","find","that","version","on","<https://package.elm-lang.org>."

430 ,"but","I","cannot","find","that","version","on","<https://package.elm-lang.org>."

279 ,"That","means","there","is","no","API","for","me","to","diff","against","and"

431 ,"That","means","there","is","no","API","for","me","to","diff","against","and"

280 ,"figure","out","if","these","are","MAJOR,","MINOR,","or","PATCH","changes."

432 ,"figure","out","if","these","are","MAJOR,","MINOR,","or","PATCH","changes."

@@ -283,116 +435,19 @@ bumpToReport bump =

283 [ D.fillSep $

435 [ D.fillSep $

284 ["Try","bumping","again","after","changing","the",D.dullyellow "\"version\"","in","elm.json"]

436 ["Try","bumping","again","after","changing","the",D.dullyellow "\"version\"","in","elm.json"]

285 ++ if length versions == 1 then ["to:"] else ["to","one","of","these:"]

437 ++ if length versions == 1 then ["to:"] else ["to","one","of","these:"]

286− , D.vcat $ map (D.green . D.fromVersion) versions

438+ , D.vcat $ map (D.green . D.fromUtf8 . V.toString) versions

287 ]

439 ]

288

440

289 BumpMustHaveLatestRegistry problem ->

441 BumpMustHaveLatestRegistry problem ->

290− toRegistryProblemReport "PROBLEM UPDATING PACKAGE LIST" problem $

442+ error "TODO BumpMustHaveLatestRegistry" 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"

296−

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

314−

315−

316−

317−-- OVERVIEW OF VERSIONING

318−

319−

320−newPackageOverview :: String

321−newPackageOverview =

322− unlines

323− [ "This package has never been published before. Here's how things work:"

324− , ""

325− , " - Versions all have exactly three parts: MAJOR.MINOR.PATCH"

326− , ""

327− , " - All packages start with initial version " ++ V.toChars V.one

328− , ""

329− , " - Versions are incremented based on how the API changes:"

330− , ""

331− , " PATCH = the API is the same, no risk of breaking code"

332− , " MINOR = values have been added, existing values are unchanged"

333− , " MAJOR = existing values have been changed or removed"

334− , ""

335− , " - I will bump versions for you, automatically enforcing these rules"

336− , ""

337− ]

338−

339−

340−

341−-- PUBLISH

342−

343−

344−data Publish

345− = PublishNoOutline

346− | PublishBadOutline Outline

347− | PublishBadDetails Details

348− | PublishMustHaveLatestRegistry RegistryProblem

349− | PublishApplication

350− | PublishNotInitialVersion V.Version

351− | PublishAlreadyPublished V.Version

352− | PublishInvalidBump V.Version V.Version

353− | PublishBadBump V.Version V.Version M.Magnitude V.Version M.Magnitude

354− | PublishNoSummary

355− | PublishNoExposed

356− | PublishNoReadme

357− | PublishShortReadme

358− | PublishNoLicense

359− | PublishBuildProblem BuildProblem

360− | PublishMissingTag V.Version

361− | PublishCannotGetTag V.Version Http.Error

362− | PublishCannotGetTagData V.Version String BS.ByteString

363− | PublishCannotGetZip Http.Error

364− | PublishCannotDecodeZip String

365− | PublishCannotGetDocs V.Version V.Version DocsProblem

366− | PublishCannotRegister Http.Error

367− | PublishNoGit

368− | PublishLocalChanges V.Version

369− --

370− | PublishZipBadDetails Details

371− | PublishZipApplication

372− | PublishZipNoExposed

373− | PublishZipBuildProblem BuildProblem

374−

375−

376−publishToReport :: Publish -> Help.Report

377−publishToReport publish =

378− case publish of

379− 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− ]

386

443

387− PublishBadOutline outline ->

444+ BumpCannotFindDocs name version problem ->

388− toOutlineReport outline

445+ error "TODO BumpCannotFindDocs" name version problem

389

446

390− PublishBadDetails problem ->

447+ -- publish

391− toDetailsReport problem

392

448

393 PublishMustHaveLatestRegistry problem ->

449 PublishMustHaveLatestRegistry problem ->

394− toRegistryProblemReport "PROBLEM UPDATING PACKAGE LIST" problem $

450+ error "TODO PublishMustHaveLatestRegistry" problem

395− "I need the latest list of published packages to make sure this is safe to publish"

396

451

397 PublishApplication ->

452 PublishApplication ->

398 Help.report "UNPUBLISHABLE" Nothing "I cannot publish applications, only packages!" []

453 Help.report "UNPUBLISHABLE" Nothing "I cannot publish applications, only packages!" []

@@ -401,7 +456,7 @@ publishToReport publish =

401 Help.docReport "INVALID VERSION" Nothing

456 Help.docReport "INVALID VERSION" Nothing

402 ( D.fillSep

457 ( D.fillSep

403 ["I","cannot","publish"

458 ["I","cannot","publish"

404− ,D.red (D.fromVersion vsn)

459+ ,D.red (D.fromUtf8 (V.toString vsn))

405 ,"as","the","initial","version."

460 ,"as","the","initial","version."

406 ]

461 ]

407 )

462 )

@@ -415,7 +470,7 @@ publishToReport publish =

415 Help.docReport "ALREADY PUBLISHED" Nothing

470 Help.docReport "ALREADY PUBLISHED" Nothing

416 ( D.vcat

471 ( D.vcat

417 [ D.fillSep

472 [ D.fillSep

418− [ "Version", D.green (D.fromVersion vsn)

473+ [ "Version", D.green (D.fromUtf8 (V.toString vsn))

419 , "has", "already", "been", "published.", "You", "cannot"

474 , "has", "already", "been", "published.", "You", "cannot"

420 , "publish", "it", "again!"

475 , "publish", "it", "again!"

421 ]

476 ]

@@ -432,14 +487,14 @@ publishToReport publish =

432 Help.docReport "INVALID VERSION" (Just "elm.json")

487 Help.docReport "INVALID VERSION" (Just "elm.json")

433 ( D.fillSep $

488 ( D.fillSep $

434 ["Your","elm.json","says","the","next","version","should","be"

489 ["Your","elm.json","says","the","next","version","should","be"

435− ,D.red (D.fromVersion statedVersion) <> ","

490+ ,D.red (D.fromUtf8 (V.toString statedVersion)) <> ","

436 ,"but","that","is","not","valid","based","on","the","previously"

491 ,"but","that","is","not","valid","based","on","the","previously"

437 ,"published","versions."

492 ,"published","versions."

438 ]

493 ]

439 )

494 )

440 [ D.fillSep $

495 [ D.fillSep $

441 ["Change","the","version","back","to"

496 ["Change","the","version","back","to"

442− ,D.green (D.fromVersion latestVersion)

497+ ,D.green (D.fromUtf8 (V.toString latestVersion))

443 ,"which","is","the","most","recently","published","version."

498 ,"which","is","the","most","recently","published","version."

444 ,"From","there,","have","Elm","bump","the","version","by","running:"

499 ,"From","there,","have","Elm","bump","the","version","by","running:"

445 ]

500 ]

@@ -454,7 +509,7 @@ publishToReport publish =

454 (

509 (

455 D.fillSep $

510 D.fillSep $

456 ["Your","elm.json","says","the","next","version","should","be"

511 ["Your","elm.json","says","the","next","version","should","be"

457− ,D.red (D.fromVersion new) <> ","

512+ ,D.red (D.fromUtf8 (V.toString new)) <> ","

458 ,"indicating","a",D.fromChars (M.toChars magnitude)

513 ,"indicating","a",D.fromChars (M.toChars magnitude)

459 ,"change","to","the","public","API."

514 ,"change","to","the","public","API."

460 ,"This","does","not","match","the","API","diff","given","by:"

515 ,"This","does","not","match","the","API","diff","given","by:"

@@ -467,7 +522,7 @@ publishToReport publish =

467 ["This","command","says","this","is","a"

522 ["This","command","says","this","is","a"

468 ,D.fromChars (M.toChars realMagnitude)

523 ,D.fromChars (M.toChars realMagnitude)

469 ,"change,","so","the","next","version","should","be"

524 ,"change,","so","the","next","version","should","be"

470− ,D.green (D.fromVersion realNew) <> "."

525+ ,D.green (D.fromUtf8 (V.toString realNew)) <> "."

471 ,"Double","check","everything","to","make","sure","you"

526 ,"Double","check","everything","to","make","sure","you"

472 ,"are","publishing","what","you","want!"

527 ,"are","publishing","what","you","want!"

473 ]

528 ]

@@ -497,17 +552,16 @@ publishToReport publish =

497 ]

552 ]

498 )

553 )

499 [ D.reflow $

554 [ D.reflow $

500− "Which modules do you want users of the package to have access to? Add their\

555+ "What is the point of a package that has no modules?!"

501− \ names to the \"exposed-modules\" list."

502 ]

556 ]

503

557

504 PublishNoReadme ->

558 PublishNoReadme ->

505− toBadReadmeReport "NO README" $

559+ badReadmeReport "NO README" $

506 "Every published package must have a helpful README.md\

560 "Every published package must have a helpful README.md\

507 \ file, but I do not see one in your project."

561 \ file, but I do not see one in your project."

508

562

509 PublishShortReadme ->

563 PublishShortReadme ->

510− toBadReadmeReport "SHORT README" $

564+ badReadmeReport "SHORT README" $

511 "This README.md is too short. Having more details will help\

565 "This README.md is too short. Having more details will help\

512 \ people assess your package quickly and fairly."

566 \ people assess your package quickly and fairly."

513

567

@@ -524,8 +578,20 @@ publishToReport publish =

524 \ named LICENSE. Add that file and you will be all set!"

578 \ named LICENSE. Add that file and you will be all set!"

525 ]

579 ]

526

580

527− PublishBuildProblem buildProblem ->

581+ PublishCannotGetTag httpError ->

528− toBuildProblemReport buildProblem

582+ error "TODO PublishCannotGetTag" httpError

583+

584+ PublishCannotGetZip httpError ->

585+ error "TODO PublishCannotGetZip" httpError

586+

587+ PublishCannotDecodeZip ->

588+ error "TODO PublishCannotDecodeZip"

589+

590+ PublishCannotGetDocs docsProblem ->

591+ error "TODO PublishCannotGetDocs" docsProblem

592+

593+ PublishCannotRegister httpError ->

594+ error "TODO PublishCannotRegister" httpError

529

595

530 PublishMissingTag version ->

596 PublishMissingTag version ->

531 let vsn = V.toChars version in

597 let vsn = V.toChars version in

@@ -546,70 +612,6 @@ publishToReport publish =

546 , "The -m flag is for a helpful message. Try to make it more informative!"

612 , "The -m flag is for a helpful message. Try to make it more informative!"

547 ]

613 ]

548

614

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−

613 PublishNoGit ->

615 PublishNoGit ->

614 Help.report "NO GIT" Nothing

616 Help.report "NO GIT" Nothing

615 "I searched your PATH environment variable for `git` and could not\

617 "I searched your PATH environment variable for `git` and could not\

@@ -639,21 +641,9 @@ publishToReport publish =

639 ++ vsn ++ "` and publish your code from there."

641 ++ vsn ++ "` and publish your code from there."

640 ]

642 ]

641

643

642− PublishZipBadDetails _ ->

643− badZipReport

644−

645− PublishZipApplication ->

646− badZipReport

647−

648− PublishZipNoExposed ->

649− badZipReport

650

644

651− PublishZipBuildProblem _ ->

652− badZipReport

653−

654−

655−toBadReadmeReport :: String -> String -> Help.Report

645+badReadmeReport :: String -> String -> Help.Report

656−toBadReadmeReport title summary =

646+badReadmeReport title summary =

657 Help.report title (Just "README.md") summary

647 Help.report title (Just "README.md") summary

658 [ D.reflow $

648 [ D.reflow $

659 "When people look at your README, they are wondering:"

649 "When people look at your README, they are wondering:"

@@ -666,653 +656,32 @@ toBadReadmeReport title summary =

666 \ most common usage scenario. Show people what they can expect if\

656 \ most common usage scenario. Show people what they can expect if\

667 \ they learn more!"

657 \ they learn more!"

668 , D.toSimpleNote $

658 , D.toSimpleNote $

669− "By publishing your package, you are inviting people to invest time in\

659+ "By publishing your package, you are inviting people to invest time\

670− \ understanding your work. Spending an hour on your README to communicate your\

660+ \ in understanding your work. Spending an hour to communicate your\

671− \ knowledge more clearly can save the community days or weeks of time in\

661+ \ knowledge more clearly can save the community days or weeks of time\

672− \ aggregate, and saving time in aggregate is the whole point of publishing\

662+ \ in aggregate, and saving time in aggregate is the whole point of\

673− \ packages! People really appreciate it, and it makes the whole ecosystem feel\

663+ \ publishing packages! People really appreciate it, and it makes the\

674− \ nicer!"

664+ \ whole ecosystem feel 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?"

687 ]

665 ]

688

666

689

667

690

668

691−-- DOCS

669+-- DETAILS TO REPORT

692−

693−

694−data DocsProblem

695− = DP_Http Http.Error

696− | DP_Data String BS.ByteString

697− | DP_Cache

698−

699−

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−

734−

735−-- INSTALL

736−

737−

738−data Install

739− = InstallNoOutline

740− | InstallBadOutline Outline

741− | InstallBadRegistry RegistryProblem

742− | InstallNoArgs FilePath

743− | InstallNoOnlineAppSolution Pkg.Name

744− | InstallNoOfflineAppSolution Pkg.Name

745− | InstallNoOnlinePkgSolution Pkg.Name

746− | InstallNoOfflinePkgSolution Pkg.Name

747− | InstallHadSolverTrouble Solver

748− | InstallUnknownPackageOnline Pkg.Name [Pkg.Name]

749− | InstallUnknownPackageOffline Pkg.Name [Pkg.Name]

750− | InstallBadDetails Details

751−

752−

753−installToReport :: Install -> Help.Report

754−installToReport exit =

755− case exit of

756− InstallNoOutline ->

757− Help.report "NEW PROJECT?" Nothing

758− "Are you trying to start a new project? Try this command instead:"

759− [ D.indent 4 $ D.green "elm init"

760− , D.reflow "It will help you get started!"

761− ]

762−

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−

770− InstallNoArgs elmHome ->

771− Help.report "INSTALL WHAT?" Nothing

772− "I am expecting commands like:"

773− [ D.green $ D.indent 4 $ D.vcat $

774− [ "elm install elm/http"

775− , "elm install elm/json"

776− , "elm install elm/random"

777− ]

778− , D.toFancyHint

779− ["In","JavaScript","folks","run","`npm install`","to","start","projects."

780− ,"\"Gotta","download","everything!\"","But","why","download","packages"

781− ,"again","and","again?","Instead,","Elm","caches","packages","in"

782− ,D.dullyellow (D.fromChars elmHome)

783− ,"so","each","one","is","downloaded","and","built","ONCE","on","your","machine."

784− ,"Elm","projects","check","that","cache","before","trying","the","internet."

785− ,"This","reduces","build","times,","reduces","server","costs,","and","makes","it"

786− ,"easier","to","work","offline.","As","a","result"

787− ,D.dullcyan "elm install","is","only","for","adding","dependencies","to","elm.json,"

788− ,"whereas",D.dullcyan "elm make","is","in","charge","of","gathering","dependencies"

789− ,"and","building","everything.","So","maybe","try",D.green "elm make","instead?"

790− ]

791− ]

792−

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!"

803− , D.reflow $

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!"

816− ]

817−

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

830−

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

849−

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

862−

863− InstallHadSolverTrouble solver ->

864− toSolverReport solver

865−

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

878−

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

893−

894− InstallBadDetails details ->

895− toDetailsReport details

896−

897−

898−

899−-- SOLVER

900−

901−

902−data Solver

903− = SolverBadCacheData Pkg.Name V.Version

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"

942−

943−

944−

945−-- OUTLINE

946−

947−

948−data Outline

949− = OutlineHasBadStructure (Decode.Error OutlineProblem)

950− | OutlineHasMissingSrcDirs FilePath [FilePath]

951− | OutlineHasDuplicateSrcDirs FilePath FilePath FilePath

952− | OutlineNoPkgCore

953− | OutlineNoAppCore

954− | OutlineNoAppJson

955−

956−

957−data OutlineProblem

958− = OP_BadType

959− | OP_BadPkgName Row Col

960− | OP_BadVersion Row Col

961− | OP_BadConstraint C.Error

962− | OP_BadModuleName Row Col

963− | OP_BadModuleHeaderTooLong

964− | OP_BadDependencyName Row Col

965− | OP_BadLicense Json.String [Json.String]

966− | OP_BadSummaryTooLong

967− | OP_NoSrcDirs

968−

969−

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

986−

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

995−

996− OutlineHasDuplicateSrcDirs canonicalDir dir1 dir2 ->

997− if dir1 == dir2 then

998− Help.report "REDUNDANT SOURCE DIRECTORIES" (Just "elm.json")

999− "I need a valid elm.json file, but the \"source-directories\" field lists the same directory twice:"

1000− [ D.indent 4 $ D.vcat $

1001− map (D.red . D.fromChars) [dir1,dir2]

1002− , D.reflow $

1003− "Remove one of the entries!"

1004− ]

1005− else

1006− Help.report "REDUNDANT SOURCE DIRECTORIES" (Just "elm.json")

1007− "I need a valid elm.json file, but the \"source-directories\" field has some redundant directories:"

1008− [ D.indent 4 $ D.vcat $

1009− map (D.red . D.fromChars) [dir1,dir2]

1010− , D.reflow $

1011− "These are two different ways of refering to the same directory:"

1012− , D.indent 4 $ D.dullyellow $ D.fromChars canonicalDir

1013− , D.reflow $

1014− "Remove one of the redundant entries from your \"source-directories\" field."

1015− ]

1016−

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

1026−

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

1036−

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

1046−

1047−

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)

1053−

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

1068−

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

1106−

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

1116−

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

1161−

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

1173−

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

1190−

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

1209−

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

1227−

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

1244−

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

1254−

1255−

1256−

1257−-- DETAILS

1258−

1259−

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]

1270−

1271−

1272−data DetailsBadDep

1273− = BD_BadDownload Pkg.Name V.Version PackageProblem

1274− | BD_BadBuild Pkg.Name V.Version (Map.Map Pkg.Name V.Version)

1275

670

1276

671

1277−toDetailsReport :: Details -> Help.Report

672+detailsToReport :: Details -> Help.Report

1278−toDetailsReport details =

673+detailsToReport details =

1279 case details of

674 case details of

1280− DetailsNoSolution ->

675+ DetailsCorrupt ->

1281− Help.report "INCOMPATIBLE DEPENDENCIES" (Just "elm.json")

676+ error "TODO DetailsCorrupt"

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

1291−

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

1305−

1306− DetailsSolverProblem solver ->

1307− toSolverReport solver

1308

677

1309 DetailsBadElmInPkg constraint ->

678 DetailsBadElmInPkg constraint ->

1310 Help.report "ELM VERSION MISMATCH" (Just "elm.json")

679 Help.report "ELM VERSION MISMATCH" (Just "elm.json")

1311 "Your elm.json says this package needs a version of Elm in this range:"

680 "Your elm.json says this package needs a version of Elm in this range:"

1312− [ D.indent 4 $ D.dullyellow $ D.fromChars $ C.toChars constraint

681+ [ D.indent 4 $ D.dullyellow $ D.fromUtf8 $ C.toString constraint

1313 , D.fillSep

682 , D.fillSep

1314 [ "But", "you", "are", "using", "Elm"

683 [ "But", "you", "are", "using", "Elm"

1315− , D.red (D.fromVersion V.compiler)

684+ , D.red (D.fromUtf8 (V.toString V.compiler))

1316 , "right", "now."

685 , "right", "now."

1317 ]

686 ]

1318 ]

687 ]

@@ -1322,286 +691,40 @@ toDetailsReport details =

1322 "Your elm.json says this application needs a different version of Elm."

691 "Your elm.json says this application needs a different version of Elm."

1323 [ D.fillSep

692 [ D.fillSep

1324 [ "It", "requires"

693 [ "It", "requires"

1325− , D.green (D.fromVersion version) <> ","

694+ , D.green (D.fromUtf8 (V.toString version)) <> ","

1326 , "but", "you", "are", "using"

695 , "but", "you", "are", "using"

1327− , D.red (D.fromVersion V.compiler)

696+ , D.red (D.fromUtf8 (V.toString V.compiler))

1328 , "right", "now."

697 , "right", "now."

1329 ]

698 ]

1330 ]

699 ]

1331

700

1332 DetailsHandEditedDependencies ->

701 DetailsHandEditedDependencies ->

1333− Help.report "ERROR IN DEPENDENCIES" (Just "elm.json")

702+ error "TODO DetailsHandEditedDependencies"

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

1344

703

1345− DetailsBadOutline outline ->

704+ DetailsBadOutline problem ->

1346− toOutlineReport outline

705+ error "TODO DetailsBadOutline" problem

1347

706

1348 DetailsCannotGetRegistry problem ->

707 DetailsCannotGetRegistry problem ->

1349− toRegistryProblemReport "PROBLEM LOADING PACKAGE LIST" problem $

708+ error "TODO DetailsCannotGetRegistry" 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− ]

1365−

1366− d:_ ->

1367− case d of

1368− BD_BadDownload pkg vsn packageProblem ->

1369− toPackageProblemReport pkg vsn packageProblem

1370−

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

1391−

1392−

1393−toBadDepRank :: DetailsBadDep -> Int -- lower is better

1394−toBadDepRank badDep =

1395− case badDep of

1396− BD_BadDownload _ _ _ -> 0

1397− BD_BadBuild _ _ _ -> 1

1398−

1399

709

710+ DetailsCannotBuildPackage name version problem ->

711+ error "TODO DetailsCannotBuildPackage" name version problem

1400

712

1401−-- PACKAGE PROBLEM

713+ DetailsNoSolution ->

1402−

714+ error "TODO DetailsNoSolution"

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

1484−

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

715

716+ DetailsNoOfflineSolution ->

717+ error "TODO DetailsNoOfflineSolution"

1583

718

719+ DetailsSolverProblem _ ->

720+ error "TODO DetailsSolverProblem"

1584

721

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

1599

722

1600

723

1601makeToReport :: Make -> Help.Report

724makeToReport :: Make -> Help.Report

1602makeToReport make =

725makeToReport make =

1603 case make of

726 case make of

1604− MakeNoOutline ->

727+ MakeNeedsOutline ->

1605 Help.report "NO elm.json FILE" Nothing

728 Help.report "NO elm.json FILE" Nothing

1606 "It looks like you are starting a new Elm project. Very exciting! Try running:"

729 "It looks like you are starting a new Elm project. Very exciting! Try running:"

1607 [ D.indent 4 $ D.green $ "elm init"

730 [ D.indent 4 $ D.green $ "elm init"

@@ -1622,344 +745,27 @@ makeToReport make =

1622 \ at once though! Pick just one of those flags and it should work!"

745 \ at once though! Pick just one of those flags and it should work!"

1623 ]

746 ]

1624

747

1625− MakeBadDetails detailsProblem ->

748+ MakeBlockedByDetailsProblem detailsProblem ->

1626− toDetailsReport detailsProblem

749+ detailsToReport detailsProblem

1627

750

1628 MakeAppNeedsFileNames ->

751 MakeAppNeedsFileNames ->

1629 Help.report "NO INPUT" Nothing

752 Help.report "NO INPUT" Nothing

1630− "What should I make though? I need specific files like:"

753+ "What should I make though? I need a specific file like this:"

1631− [ D.vcat

754+ [ D.indent 4 $ D.green "elm make src/Main.elm"

1632− [ D.indent 4 $ D.green "elm make src/Main.elm"

755+ , D.reflow

1633− , D.indent 4 $ D.green "elm make src/This.elm src/That.elm"

756+ "However many files you give, I will create one JS file out of them."

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!"

1638 ]

757 ]

1639

758

1640 MakePkgNeedsExposing ->

759 MakePkgNeedsExposing ->

1641− Help.report "NO INPUT" Nothing

760+ error "TODO MakePkgNeedsExposing"

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

1651

761

1652 MakeMultipleFilesIntoHtml ->

762 MakeMultipleFilesIntoHtml ->

1653− Help.report "TOO MANY FILES" Nothing

763+ error "TODO MakeMultipleFilesIntoHtml"

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

764

1672− MakeNoMain ->

765+ MakeNonMainFilesIntoJavaScript _ _ ->

1673− Help.report "NO MAIN" Nothing

766+ error "TODO MakeNonMainFilesIntoJavaScript"

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

767

1865− BP_CannotLoadDependencies ->

768+ MakeCannotOptimizeDebugValues m ms ->

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]

1954−

1955−

1956−toGenerateReport :: Generate -> Help.Report

1957−toGenerateReport problem =

1958− case problem of

1959− GenerateCannotLoadArtifacts ->

1960− corruptCacheReport

1961−

1962− GenerateCannotOptimizeDebugValues m ms ->

1963 Help.report "DEBUG REMNANTS" Nothing

769 Help.report "DEBUG REMNANTS" Nothing

1964 "There are uses of the `Debug` module in the following modules:"

770 "There are uses of the `Debug` module in the following modules:"

1965 [ D.indent 4 $ D.red $ D.vcat $ map (D.fromChars . ModuleName.toChars) (m:ms)

771 [ D.indent 4 $ D.red $ D.vcat $ map (D.fromChars . ModuleName.toChars) (m:ms)

@@ -1968,7 +774,7 @@ toGenerateReport problem =

1968 "The issue is that --optimize strips out info needed by `Debug` functions.\

774 "The issue is that --optimize strips out info needed by `Debug` functions.\

1969 \ Here are two examples:"

775 \ Here are two examples:"

1970 , D.indent 4 $ D.reflow $

776 , D.indent 4 $ D.reflow $

1971− "(1) It shortens record field names. This makes the generated JavaScript\

777+ "(1) It shortens record field names. This makes the generated JavaScript is\

1972 \ smaller, but `Debug.toString` cannot know the real field names anymore."

778 \ smaller, but `Debug.toString` cannot know the real field names anymore."

1973 , D.indent 4 $ D.reflow $

779 , D.indent 4 $ D.reflow $

1974 "(2) Values like `type Height = Height Float` are unboxed. This reduces\

780 "(2) Values like `type Height = Height Float` are unboxed. This reduces\

@@ -1981,89 +787,42 @@ toGenerateReport problem =

1981 \ exists!"

787 \ exists!"

1982 ]

788 ]

1983

789

790+ MakeCannotBuild buildProblem ->

791+ case buildProblem of

792+ BuildProjectProblem bp ->

793+ case bp of

794+ BP_PathUnknown _ ->

795+ error "TODO BP_PathUnknown"

1984

796

797+ BP_WithBadExtension _ ->

798+ error "TODO BP_WithBadExtension"

1985

799

1986−-- CORRUPT CACHE

800+ BP_WithAmbiguousSrcDir _ _ ->

1987−

801+ error "TODO BP_WithAmbiguousSrcDir"

1988−

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

2000−

2001−

2002−

2003−-- REACTOR

2004−

2005−

2006−data Reactor

2007− = ReactorNoOutline

2008− | ReactorBadDetails Details

2009− | ReactorBadBuild BuildProblem

2010− | ReactorBadGenerate Generate

2011−

2012−

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

2022−

2023− ReactorBadDetails details ->

2024− toDetailsReport details

2025−

2026− ReactorBadBuild buildProblem ->

2027− toBuildProblemReport buildProblem

2028−

2029− ReactorBadGenerate generate ->

2030− toGenerateReport generate

2031−

2032−

2033−

2034−-- REPL

2035−

2036−

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

2045−

2046

802

2047−replToReport :: Repl -> Help.Report

803+ BP_MainPathDuplicate _ _ ->

2048−replToReport problem =

804+ error "TODO BP_MainPathDuplicate"

2049− case problem of

2050− ReplBadDetails details ->

2051− toDetailsReport details

2052

805

2053− ReplBadInput source err ->

806+ BP_MainNameDuplicate _ _ _ ->

2054− Help.compilerReport "/" (Error.Module N.replModule "REPL" File.zeroTime source err) []

807+ error "TODO BP_MainNameDuplicate"

2055

808

2056− ReplBadLocalDeps root e es ->

809+ BP_CannotLoadDependencies ->

2057− Help.compilerReport root e es

810+ error "TODO BP_CannotLoadDependencies"

2058

811

2059− ReplProjectProblem projectProblem ->

812+ BP_Cycle name names ->

2060− toProjectProblemReport projectProblem

813+ Help.report "IMPORT CYCLE" Nothing

814+ "Your module imports form a cycle:"

815+ [ D.cycle 4 name names

816+ , D.reflow $

817+ "Learn more about why this is disallowed and how to break cycles here:"

818+ ++ D.makeLink "import-cycles"

819+ ]

2061

820

2062− ReplBadGenerate generate ->

821+ BP_MissingExposed _ ->

2063− toGenerateReport generate

822+ error "TODO BP_MissingExposed"

2064

823

2065− ReplBadCache ->

824+ BuildModuleProblems p ps ->

2066− corruptCacheReport

825+ Help.compilerReport p ps

2067

826

2068− ReplBlocked ->

827+ MakeCannotLoadArtifacts ->

2069− corruptCacheReport

828+ error "TODO MakeCannotLoadArtifacts"

builder/src/Reporting/Exit/Assets.hsnew file+227

@@ -0,0 +1,227 @@

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.hsnew file+345

@@ -0,0 +1,345 @@

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.hsnew file+123

@@ -0,0 +1,123 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module Reporting.Exit.Deps

3+ ( Exit(..)

4+ , toReport

5+ )

6+ where

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+10−9

@@ -14,6 +14,7 @@ module Reporting.Exit.Help

14 where

17+import qualified Data.Utf8 as Utf8

17import GHC.IO.Handle (hIsTerminalDevice)

18import GHC.IO.Handle (hIsTerminalDevice)

18import System.IO (Handle, hPutStr, stderr, stdout)

19import System.IO (Handle, hPutStr, stderr, stdout)

@@ -29,7 +30,7 @@ import qualified Reporting.Error as Error

31data Report

32data Report

32− = CompilerReport FilePath Error.Module [Error.Module]

33+ = CompilerReport Error.Module [Error.Module]

33 | Report

34 | Report

34 { _title :: String

35 { _title :: String

35 , _path :: Maybe FilePath

36 , _path :: Maybe FilePath

@@ -52,7 +53,7 @@ jsonReport =

52 Report

53 Report

55−compilerReport :: FilePath -> Error.Module -> [Error.Module] -> Report

56+compilerReport :: Error.Module -> [Error.Module] -> Report

56compilerReport =

57compilerReport =

57 CompilerReport

58 CompilerReport

@@ -64,8 +65,8 @@ compilerReport =

64reportToDoc :: Report -> D.Doc

65reportToDoc :: Report -> D.Doc

65reportToDoc report_ =

66reportToDoc report_ =

66 case report_ of

67 case report_ of

67− CompilerReport root e es ->

68+ CompilerReport e es ->

68− Error.toDoc root e es

69+ Error.toDoc e es

70 Report title maybePath message ->

71 Report title maybePath message ->

71 let

72 let

@@ -94,17 +95,17 @@ reportToDoc report_ =

94reportToJson :: Report -> E.Value

95reportToJson :: Report -> E.Value

95reportToJson report_ =

96reportToJson report_ =

96 case report_ of

97 case report_ of

97− CompilerReport _ e es ->

98+ CompilerReport e es ->

98 E.object

99 E.object

99− [ "type" ==> E.chars "compile-errors"

100+ [ "type" ==> E.string "compile-errors"

100 , "errors" ==> E.list Error.toJson (e:es)

101 , "errors" ==> E.list Error.toJson (e:es)

101 ]

102 ]

102

103

103 Report title maybePath message ->

104 Report title maybePath message ->

104 E.object

105 E.object

105− [ "type" ==> E.chars "error"

106+ [ "type" ==> E.string "error"

106− , "path" ==> maybe E.null E.chars maybePath

107+ , "path" ==> maybe E.null (E.string . Utf8.fromChars) maybePath

107− , "title" ==> E.chars title

108+ , "title" ==> E.string (Utf8.fromChars title)

108 , "message" ==> D.encode message

109 , "message" ==> D.encode message

109 ]

110 ]

110

111

builder/src/Reporting/Exit/Http.hsnew file+104

@@ -0,0 +1,104 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module Reporting.Exit.Http

3+ ( Exit(..)

4+ , toReport

5+ , BadJson(..)

6+ , badJsonToDocs

7+ )

8+ where

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,10 +3,8 @@ module Reporting.Task

3 ( Task

4 , run

5 , throw

6− , mapError

7 --

6 --

8 , io

7 , io

9− , mio

10 , eio

8 , eio

11 )

9 )

12 where

10 where

@@ -33,12 +31,6 @@ throw x =

33 Task $ \_ err -> err x

31 Task $ \_ err -> err x

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−

43-- IO

35-- IO

@@ -49,15 +41,6 @@ io work =

49 Task $ \ok _ -> work >>= ok

41 Task $ \ok _ -> work >>= ok

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−

61eio :: (x -> y) -> IO (Either x a) -> Task y a

44eio :: (x -> y) -> IO (Either x a) -> Task y a

62eio func work =

45eio func work =

63 Task $ \ok err ->

46 Task $ \ok err ->

builder/src/Stuff.hs+9−8

@@ -8,8 +8,8 @@ module Stuff

8 , elmo

9 , temp

10 , findRoot

11− , withRootLock

11+ , withProjectLock

12− , withRegistryLock

12+ , withCacheLock

13 , PackageCache

14 , getPackageCache

15 , registry

@@ -120,16 +120,17 @@ findRootHelp dirs =

120-- LOCKS

121

122

123−withRootLock :: FilePath -> IO a -> IO a

123+withProjectLock :: FilePath -> IO a -> IO a

124−withRootLock root work =

124+withProjectLock root work =

125 do let dir = stuff root

126 Dir.createDirectoryIfMissing True dir

127− Lock.withFileLock (dir </> "lock") Lock.Exclusive (\_ -> work)

127+ Lock.withFileLock (dir </> "project.lock") Lock.Exclusive (\_ -> work)

128

129

130−withRegistryLock :: PackageCache -> IO a -> IO a

130+withCacheLock :: PackageCache -> IO a -> IO a

131−withRegistryLock (PackageCache dir) work =

131+withCacheLock (PackageCache dir) work =

132− Lock.withFileLock (dir </> "lock") Lock.Exclusive (\_ -> work)

132+ Lock.withFileLock (dir </> "cache.lock") Lock.Exclusive (\_ -> work)

133+

133

134

135

136

cabal.configdeleted−2

@@ -1,2 +0,0 @@

1−profiling: False

2−library-profiling: True

compiler/src/AST/Canonical.hs+2−2

@@ -342,7 +342,7 @@ instance Binary CtorOpts where

342 0 -> return Normal

343 1 -> return Enum

344 2 -> return Unbox

345− _ -> fail "binary encoding of CtorOpts was corrupted"

345+ _ -> error "binary encoding of CtorOpts was corrupted"

346

347

348instance Binary Annotation where

@@ -393,7 +393,7 @@ instance Binary AliasType where

393 case n of

394 0 -> liftM Holey get

395 1 -> liftM Filled get

396− _ -> fail "binary encoding of AliasType was corrupted"

396+ _ -> error "binary encoding of AliasType was corrupted"

397

398

399instance Binary FieldType where

compiler/src/AST/Optimized.hs+9−9

@@ -135,7 +135,7 @@ data GlobalGraph =

135data LocalGraph =

136 LocalGraph

137 { _l_main :: Maybe Main

138− , _l_nodes :: Map.Map Global Node -- PERF profile switching Global to Name

138+ , _l_nodes :: Map.Map Global Node -- TODO profile switching Global to Name

139 , _l_fields :: Map.Map Name Int

140 }

141

@@ -308,7 +308,7 @@ instance Binary Expr where

308 24 -> pure Unit

309 25 -> liftM3 Tuple get get get

310 26 -> liftM3 Shader get get get

311− _ -> fail "problem getting Opt.Expr binary"

311+ _ -> error "problem getting Opt.Expr binary"

312

313

314instance Binary Def where

@@ -322,7 +322,7 @@ instance Binary Def where

322 case word of

323 0 -> liftM2 Def get get

324 1 -> liftM3 TailDef get get get

325− _ -> fail "problem getting Opt.Def binary"

325+ _ -> error "problem getting Opt.Def binary"

326

327

328instance Binary Destructor where

@@ -345,7 +345,7 @@ instance Binary Path where

345 1 -> liftM2 Field get get

346 2 -> liftM Unbox get

347 3 -> liftM Root get

348− _ -> fail "problem getting Opt.Path binary"

348+ _ -> error "problem getting Opt.Path binary"

349

350

351instance (Binary a) => Binary (Decider a) where

@@ -361,7 +361,7 @@ instance (Binary a) => Binary (Decider a) where

361 0 -> liftM Leaf get

362 1 -> liftM3 Chain get get get

363 2 -> liftM3 FanOut get get get

364− _ -> fail "problem getting Opt.Decider binary"

364+ _ -> error "problem getting Opt.Decider binary"

365

366

367instance Binary Choice where

@@ -375,7 +375,7 @@ instance Binary Choice where

375 case word of

376 0 -> liftM Inline get

377 1 -> liftM Jump get

378− _ -> fail "problem getting Opt.Choice binary"

378+ _ -> error "problem getting Opt.Choice binary"

379

380

381

@@ -400,7 +400,7 @@ instance Binary Main where

400 case word of

401 0 -> return Static

402 1 -> liftM2 Dynamic get get

403− _ -> fail "problem getting Opt.Main binary"

403+ _ -> error "problem getting Opt.Main binary"

404

405

406instance Binary Node where

@@ -432,7 +432,7 @@ instance Binary Node where

432 8 -> liftM2 Kernel get get

433 9 -> liftM2 PortIncoming get get

434 10 -> liftM2 PortOutgoing get get

435− _ -> fail "problem getting Opt.Node binary"

435+ _ -> error "problem getting Opt.Node binary"

436

437

438instance Binary EffectsType where

@@ -448,4 +448,4 @@ instance Binary EffectsType where

448 0 -> return Cmd

449 1 -> return Sub

450 2 -> return Fx

451− _ -> fail "problem getting Opt.EffectsType binary"

451+ _ -> error "problem getting Opt.EffectsType binary"

compiler/src/AST/Source.hs+5−5

@@ -195,15 +195,15 @@ newtype Comment =

195

196data Exposing

197 = Open

198− | Explicit [Exposed]

198+ | Explicit [A.Located Exposed]

199

200

201data Exposed

202− = Lower (A.Located Name)

202+ = Lower Name

203− | Upper (A.Located Name) Privacy

203+ | Upper Name Privacy

204− | Operator A.Region Name

204+ | Operator Name

205

206

207data Privacy

208− = Public A.Region

208+ = Public

209 | Private

compiler/src/AST/Utils/Binop.hs+6−5

@@ -41,11 +41,12 @@ instance Binary Precedence where

41instance Binary Associativity where

42 get =

43 do n <- getWord8

44− case n of

44+ return $

45− 0 -> return Left

45+ case n of

46− 1 -> return Non

46+ 0 -> Left

47− 2 -> return Right

47+ 1 -> Non

48− _ -> fail "Error reading valid associativity from serialized string"

48+ 2 -> Right

49+ _ -> error "Error reading valid associativity from serialized string"

50 put assoc =

51 put assoc =

51 putWord8 $

52 putWord8 $

compiler/src/AST/Utils/Shader.hs−2

@@ -74,11 +74,9 @@ escape chars =

74 []

76 c:cs

77− | c == '\r' -> escape cs

78 | c == '\n' -> '\\' : 'n' : escape cs

77 | c == '\n' -> '\\' : 'n' : escape cs

79 | c == '\"' -> '\\' : '"' : escape cs

78 | c == '\"' -> '\\' : '"' : escape cs

80 | c == '\'' -> '\\' : '\'' : escape cs

79 | c == '\'' -> '\\' : '\'' : escape cs

81− | c == '\\' -> '\\' : '\\' : escape cs

82 | otherwise -> c : escape cs

80 | otherwise -> c : escape cs

compiler/src/AST/Utils/Type.hs+1

@@ -1,4 +1,5 @@

1{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

2module AST.Utils.Type

3module AST.Utils.Type

3 ( delambda

4 ( delambda

4 , dealias

5 , dealias

compiler/src/Canonicalize/Environment.hs+20−50

@@ -4,8 +4,6 @@ module Canonicalize.Environment

4 ( Env(..)

5 , Exposed

6 , Qualified

7− , Info(..)

8− , mergeInfo

9 , Var(..)

7 , Var(..)

10 , Type(..)

8 , Type(..)

11 , Ctor(..)

9 , Ctor(..)

@@ -22,8 +20,8 @@ module Canonicalize.Environment

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

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

24import qualified Data.Map.Strict as Map

22import qualified Data.Map.Strict as Map

23+import qualified Data.Map.Strict.Internal as I

25import qualified Data.Name as Name

24import qualified Data.Name as Name

26−import qualified Data.OneOrMore as OneOrMore

28import qualified AST.Utils.Binop as Binop

26import qualified AST.Utils.Binop as Binop

29import qualified AST.Canonical as Can

27import qualified AST.Canonical as Can

@@ -60,34 +58,11 @@ data Env =

62type Exposed a =

60type Exposed a =

63− Map.Map Name.Name (Info a)

61+ Map.Map Name.Name (Map.Map ModuleName.Canonical a)

66type Qualified a =

64type Qualified a =

67− Map.Map Name.Name (Map.Map Name.Name (Info a))

65+ Map.Map Name.Name (Map.Map Name.Name (Map.Map ModuleName.Canonical a))

68−

69−

70−

71−-- INFO

72−

73−

74−data Info a

75− = Specific ModuleName.Canonical a

76− | Ambiguous ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

77−

78−

79−mergeInfo :: Info a -> Info a -> Info a

80−mergeInfo info1 info2 =

81− case info1 of

82− Specific h1 _ ->

83− case info2 of

84− Specific h2 _ -> if h1 == h2 then info1 else Ambiguous h1 (OneOrMore.one h2)

85− Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more (OneOrMore.one h2) hs2)

86−

87− Ambiguous h1 hs1 ->

88− case info2 of

89− Specific h2 _ -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.one h2))

90− Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.more (OneOrMore.one h2) hs2))

@@ -97,8 +72,7 @@ mergeInfo info1 info2 =

97data Var

72data Var

98 = Local A.Region

73 = Local A.Region

99 | TopLevel A.Region

74 | TopLevel A.Region

100− | Foreign ModuleName.Canonical Can.Annotation

75+ | Foreign (Map.Map ModuleName.Canonical Can.Annotation)

101− | Foreigns ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

102

103

104

@@ -165,10 +139,7 @@ addLocalLeft _ region =

165addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var

139addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var

166addLocalBoth name region var =

140addLocalBoth name region var =

167 case var of

141 case var of

168− Foreign _ _ ->

142+ Foreign _ ->

169− Result.ok (Local region)

170−

171− Foreigns _ _ ->

172 Result.ok (Local region)

143 Result.ok (Local region)

173

144

174 Local parentRegion ->

145 Local parentRegion ->

@@ -179,18 +150,17 @@ addLocalBoth name region var =

179

150

180

151

181

152

182−

183-- FIND TYPE

153-- FIND TYPE

184

154

185

155

186findType :: A.Region -> Env -> Name.Name -> Result i w Type

156findType :: A.Region -> Env -> Name.Name -> Result i w Type

187findType region (Env _ _ ts _ _ _ qts _) name =

157findType region (Env _ _ ts _ _ _ qts _) name =

188 case Map.lookup name ts of

158 case Map.lookup name ts of

189− Just (Specific _ tipe) ->

159+ Just (I.Bin 1 _ tipe _ _) ->

190 Result.ok tipe

160 Result.ok tipe

191

161

192− Just (Ambiguous h hs) ->

162+ Just homes ->

193− Result.throw (Error.AmbiguousType region Nothing name h hs)

163+ Result.throw (Error.AmbiguousType region Nothing name (Map.keys homes))

194

164

195 Nothing ->

165 Nothing ->

196 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))

166 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))

@@ -201,11 +171,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =

201 case Map.lookup prefix qts of

171 case Map.lookup prefix qts of

202 Just qualified ->

172 Just qualified ->

203 case Map.lookup name qualified of

173 case Map.lookup name qualified of

204− Just (Specific _ tipe) ->

174+ Just (I.Bin 1 _ tipe _ _) ->

205 Result.ok tipe

175 Result.ok tipe

206

176

207− Just (Ambiguous h hs) ->

177+ Just homes ->

208− Result.throw (Error.AmbiguousType region (Just prefix) name h hs)

178+ Result.throw (Error.AmbiguousType region (Just prefix) name (Map.keys homes))

209

179

210 Nothing ->

180 Nothing ->

211 Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))

181 Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))

@@ -221,11 +191,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =

221findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor

191findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor

222findCtor region (Env _ _ _ cs _ _ _ qcs) name =

192findCtor region (Env _ _ _ cs _ _ _ qcs) name =

223 case Map.lookup name cs of

193 case Map.lookup name cs of

224− Just (Specific _ ctor) ->

194+ Just (I.Bin 1 _ ctor _ _) ->

225 Result.ok ctor

195 Result.ok ctor

226

196

227− Just (Ambiguous h hs) ->

197+ Just homes ->

228− Result.throw (Error.AmbiguousVariant region Nothing name h hs)

198+ Result.throw (Error.AmbiguousVariant region Nothing name (Map.keys homes))

229

199

230 Nothing ->

200 Nothing ->

231 Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))

201 Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))

@@ -236,11 +206,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =

236 case Map.lookup prefix qcs of

206 case Map.lookup prefix qcs of

237 Just qualified ->

207 Just qualified ->

238 case Map.lookup name qualified of

208 case Map.lookup name qualified of

239− Just (Specific _ pattern) ->

209+ Just (I.Bin 1 _ pattern _ _) ->

240 Result.ok pattern

210 Result.ok pattern

241

211

242− Just (Ambiguous h hs) ->

212+ Just homes ->

243− Result.throw (Error.AmbiguousVariant region (Just prefix) name h hs)

213+ Result.throw (Error.AmbiguousVariant region (Just prefix) name (Map.keys homes))

244

214

245 Nothing ->

215 Nothing ->

246 Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))

216 Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))

@@ -256,11 +226,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =

256findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop

226findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop

257findBinop region (Env _ _ _ _ binops _ _ _) name =

227findBinop region (Env _ _ _ _ binops _ _ _) name =

258 case Map.lookup name binops of

228 case Map.lookup name binops of

259− Just (Specific _ binop) ->

229+ Just (I.Bin 1 _ binop _ _) ->

260 Result.ok binop

230 Result.ok binop

261

231

262− Just (Ambiguous h hs) ->

232+ Just homes ->

263− Result.throw (Error.AmbiguousBinop region name h hs)

233+ Result.throw (Error.AmbiguousBinop region name (Map.keys homes))

264

234

265 Nothing ->

235 Nothing ->

266 Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))

236 Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))

compiler/src/Canonicalize/Environment/Dups.hs+1−1

@@ -105,7 +105,7 @@ one name region value =

105

106insert :: Name.Name -> A.Region -> a -> Dict a -> Dict a

107insert name region value dict =

108− Map.insertWith (\new old -> OneOrMore.more old new) name (OneOrMore.one (Info region value)) dict

108+ Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dict

109

110

111union :: Dict a -> Dict a -> Dict a

compiler/src/Canonicalize/Environment/Foreign.hs+37−49

@@ -35,14 +35,7 @@ type Result i w a =

35createInitialEnv :: ModuleName.Canonical -> Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Result i w Env.Env

36createInitialEnv home ifaces imports =

37 do (State vs ts cs bs qvs qts qcs) <- foldM (addImport ifaces) emptyState (toSafeImports home imports)

38− Result.ok (Env.Env home (Map.map infoToVar vs) ts cs bs qvs qts qcs)

38+ Result.ok (Env.Env home (Map.map Env.Foreign vs) ts cs bs qvs qts qcs)

39−

40−

41−infoToVar :: Env.Info Can.Annotation -> Env.Var

42−infoToVar info =

43− case info of

44− Env.Specific home tipe -> Env.Foreign home tipe

45− Env.Ambiguous h hs -> Env.Foreigns h hs

@@ -68,7 +61,7 @@ emptyState =

69emptyTypes :: Env.Exposed Env.Type

62emptyTypes :: Env.Exposed Env.Type

70emptyTypes =

63emptyTypes =

71− Map.singleton "List" (Env.Specific ModuleName.list (Env.Union 1 ModuleName.list))

64+ Map.singleton "List" (Map.singleton ModuleName.list (Env.Union 1 ModuleName.list))

@@ -109,8 +102,8 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe

109 (Map.mapMaybeWithKey (unionToType home) unions)

102 (Map.mapMaybeWithKey (unionToType home) unions)

110 (Map.mapMaybeWithKey (aliasToType home) aliases)

103 (Map.mapMaybeWithKey (aliasToType home) aliases)

111

104

112− !vars = Map.map (Env.Specific home) defs

105+ !vars = Map.map (Map.singleton home) defs

113− !types = Map.map (Env.Specific home . fst) rawTypeInfo

106+ !types = Map.map (Map.singleton home . fst) rawTypeInfo

114 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo

107 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo

115

108

116 !qvs2 = addQualified prefix vars qvs

109 !qvs2 = addQualified prefix vars qvs

@@ -136,7 +129,7 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe

136

129

137addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a

130addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a

138addExposed =

131addExposed =

139− Map.unionWith Env.mergeInfo

132+ Map.unionWith Map.union

140

133

141

134

142addQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a

135addQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a

@@ -157,7 +150,7 @@ unionToTypeHelp :: ModuleName.Canonical -> Name.Name -> Can.Union -> (Env.Type,

157unionToTypeHelp home name union@(Can.Union vars ctors _ _) =

150unionToTypeHelp home name union@(Can.Union vars ctors _ _) =

158 let

151 let

159 addCtor dict (Can.Ctor ctor index _ args) =

152 addCtor dict (Can.Ctor ctor index _ args) =

160− Map.insert ctor (Env.Specific home (Env.Ctor home name union index args)) dict

153+ Map.insert ctor (Map.singleton home (Env.Ctor home name union index args)) dict

161 in

154 in

162 ( Env.Union (length vars) home

155 ( Env.Union (length vars) home

163 , List.foldl' addCtor Map.empty ctors

156 , List.foldl' addCtor Map.empty ctors

@@ -188,7 +181,7 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =

188 (Can.TAlias home name avars (Can.Filled tipe))

181 (Can.TAlias home name avars (Can.Filled tipe))

189 (Can.fieldsToList fields)

182 (Can.fieldsToList fields)

190 in

183 in

191− Map.singleton name (Env.Specific home (Env.RecordCtor home vars alias))

184+ Map.singleton name (Map.singleton home (Env.RecordCtor home vars alias))

192

185

193 _ ->

186 _ ->

194 Map.empty

187 Map.empty

@@ -199,9 +192,9 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =

199-- BINOP

192-- BINOP

200

193

201

194

202−binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Env.Info Env.Binop

195+binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Map.Map ModuleName.Canonical Env.Binop

203binopToBinop home op (I.Binop name annotation associativity precedence) =

196binopToBinop home op (I.Binop name annotation associativity precedence) =

204− Env.Specific home (Env.Binop op home name annotation associativity precedence)

197+ Map.singleton home (Env.Binop op home name annotation associativity precedence)

205

198

206

199

207

200

@@ -214,19 +207,19 @@ addExposedValue

214 -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor)

207 -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor)

215 -> Map.Map Name.Name I.Binop

208 -> Map.Map Name.Name I.Binop

216 -> State

209 -> State

217− -> Src.Exposed

210+ -> A.Located Src.Exposed

218 -> Result i w State

211 -> Result i w State

219−addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =

212+addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At region exposed) =

220 case exposed of

213 case exposed of

221− Src.Lower (A.At region name) ->

214+ Src.Lower name ->

222 case Map.lookup name vars of

215 case Map.lookup name vars of

223 Just info ->

216 Just info ->

224− Result.ok (State (Map.insertWith Env.mergeInfo name info vs) ts cs bs qvs qts qcs)

217+ Result.ok (State (Map.insert name info vs) ts cs bs qvs qts qcs)

225

218

226 Nothing ->

219 Nothing ->

227 Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))

220 Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))

228

221

229− Src.Upper (A.At region name) privacy ->

222+ Src.Upper name privacy ->

230 case privacy of

223 case privacy of

231 Src.Private ->

224 Src.Private ->

232 case Map.lookup name types of

225 case Map.lookup name types of

@@ -234,43 +227,43 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =

234 case tipe of

227 case tipe of

235 Env.Union _ _ ->

228 Env.Union _ _ ->

236 let

229 let

237− !ts2 = Map.insert name (Env.Specific home tipe) ts

230+ !ts2 = Map.insert name (Map.singleton home tipe) ts

238 in

231 in

239 Result.ok (State vs ts2 cs bs qvs qts qcs)

232 Result.ok (State vs ts2 cs bs qvs qts qcs)

240

233

241 Env.Alias _ _ _ _ ->

234 Env.Alias _ _ _ _ ->

242 let

235 let

243− !ts2 = Map.insert name (Env.Specific home tipe) ts

236+ !ts2 = Map.insert name (Map.singleton home tipe) ts

244 !cs2 = addExposed cs ctors

237 !cs2 = addExposed cs ctors

245 in

238 in

246 Result.ok (State vs ts2 cs2 bs qvs qts qcs)

239 Result.ok (State vs ts2 cs2 bs qvs qts qcs)

247

240

248 Nothing ->

241 Nothing ->

249− case checkForCtorMistake name types of

242+ case Map.lookup name (toCtors types) of

250− tipe:_ ->

243+ Just tipe ->

251 Result.throw $ Error.ImportCtorByName region name tipe

244 Result.throw $ Error.ImportCtorByName region name tipe

252

245

253− [] ->

246+ Nothing ->

254 Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)

247 Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)

255

248

256− Src.Public dotDotRegion ->

249+ Src.Public ->

257 case Map.lookup name types of

250 case Map.lookup name types of

258 Just (tipe, ctors) ->

251 Just (tipe, ctors) ->

259 case tipe of

252 case tipe of

260 Env.Union _ _ ->

253 Env.Union _ _ ->

261 let

254 let

262− !ts2 = Map.insert name (Env.Specific home tipe) ts

255+ !ts2 = Map.insert name (Map.singleton home tipe) ts

263 !cs2 = addExposed cs ctors

256 !cs2 = addExposed cs ctors

264 in

257 in

265 Result.ok (State vs ts2 cs2 bs qvs qts qcs)

258 Result.ok (State vs ts2 cs2 bs qvs qts qcs)

266

259

267 Env.Alias _ _ _ _ ->

260 Env.Alias _ _ _ _ ->

268− Result.throw (Error.ImportOpenAlias dotDotRegion name)

261+ Result.throw (Error.ImportOpenAlias region name)

269

262

270 Nothing ->

263 Nothing ->

271 Result.throw (Error.ImportExposingNotFound region home name (Map.keys types))

264 Result.throw (Error.ImportExposingNotFound region home name (Map.keys types))

272

265

273− Src.Operator region op ->

266+ Src.Operator op ->

274 case Map.lookup op binops of

267 case Map.lookup op binops of

275 Just binop ->

268 Just binop ->

276 let

269 let

@@ -282,23 +275,18 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =

282 Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))

275 Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))

283

276

284

277

285−checkForCtorMistake :: Name.Name -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> [Name.Name]

278+

286−checkForCtorMistake givenName types =

279+toCtors :: Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> Map.Map Name.Name Name.Name

287− Map.foldr addMatches [] types

280+toCtors types =

281+ Map.foldr addCtors Map.empty types

288 where

282 where

289− addMatches (_, exposedCtors) matches =

283+ addCtors (_, exposedCtors) dict =

290− Map.foldrWithKey addMatch matches exposedCtors

284+ Map.foldrWithKey addCtor dict exposedCtors

291−

285+

292− addMatch ctorName info matches =

286+ addCtor ctorName homes dict =

293− if ctorName /= givenName

287+ case Map.elems homes of

294− then matches

288+ [Env.Ctor _ tipeName _ _ _] ->

295− else

289+ Map.insert ctorName tipeName dict

296− case info of

290+

297− Env.Specific _ (Env.Ctor _ tipeName _ _ _) ->

291+ _ ->

298− tipeName : matches

292+ dict

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

110addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> A.Located Src.Union -> Result i w (Env.Exposed Env.Type)

111addUnion home types union@(A.At _ (Src.Union (A.At _ name) _ _)) =

112 do arity <- checkUnionFreeVars union

113− let one = Env.Specific home (Env.Union arity home)

113+ let one = Map.singleton home (Env.Union arity home)

114 Result.ok $ Map.insert name one types

115

116

@@ -133,7 +133,7 @@ addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =

133 Graph.AcyclicSCC alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) ->

134 do args <- checkAliasFreeVars alias

135 ctype <- Type.canonicalize env tipe

136− let one = Env.Specific home (Env.Alias (length args) home args ctype)

136+ let one = Map.singleton home (Env.Alias (length args) home args ctype)

137 let ts1 = Map.insert name one ts

138 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs

139

@@ -281,7 +281,7 @@ addCtors (Src.Module _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts cs bs

281 )

282

283

284−type CtorDups = Dups.Dict (Env.Info Env.Ctor)

284+type CtorDups = Dups.Dict (Map.Map ModuleName.Canonical Env.Ctor)

285

286

287

@@ -297,7 +297,7 @@ canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Alias (A.At regi

297 ,

298 case ctipe of

299 Can.TRecord fields Nothing ->

300− Dups.one name region (Env.Specific home (toRecordCtor home name vars fields))

300+ Dups.one name region (Map.singleton home (toRecordCtor home name vars fields))

301

302 _ ->

303 Dups.none

@@ -351,5 +351,5 @@ toOpts ctors =

351

352toCtor :: ModuleName.Canonical -> Name.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups

353toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =

354− Dups.one name region $ Env.Specific home $

354+ Dups.one name region $ Map.singleton home $

355 Env.Ctor home typeName union index args

compiler/src/Canonicalize/Expression.hs+7−6

@@ -14,6 +14,7 @@ import Control.Monad (foldM)

14import qualified Data.Graph as Graph

15import qualified Data.List as List

16import qualified Data.Map.Strict as Map

17+import qualified Data.Map.Strict.Internal as I

17import qualified Data.Name as Name

18import qualified Data.Name as Name

19import qualified AST.Canonical as Can

20import qualified AST.Canonical as Can

@@ -695,15 +696,15 @@ findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =

695 Env.TopLevel _ ->

696 Env.TopLevel _ ->

696 logVar name (Can.VarTopLevel localHome name)

697 logVar name (Can.VarTopLevel localHome name)

697

698

698− Env.Foreign home annotation ->

699+ Env.Foreign (I.Bin 1 home annotation _ _) ->

699 Result.ok $

700 Result.ok $

700 if home == ModuleName.debug then

701 if home == ModuleName.debug then

701 Can.VarDebug localHome name annotation

702 Can.VarDebug localHome name annotation

702 else

703 else

703 Can.VarForeign home name annotation

704 Can.VarForeign home name annotation

704

705

705− Env.Foreigns h hs ->

706+ Env.Foreign homes ->

706− Result.throw (Error.AmbiguousVar region Nothing name h hs)

707+ Result.throw (Error.AmbiguousVar region Nothing name (Map.keys homes))

707

708

708 Nothing ->

709 Nothing ->

709 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))

710 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))

@@ -714,15 +715,15 @@ findVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =

714 case Map.lookup prefix qvs of

715 case Map.lookup prefix qvs of

715 Just qualified ->

716 Just qualified ->

716 case Map.lookup name qualified of

717 case Map.lookup name qualified of

717− Just (Env.Specific home annotation) ->

718+ Just (I.Bin 1 home annotation _ _) ->

718 Result.ok $

719 Result.ok $

719 if home == ModuleName.debug then

720 if home == ModuleName.debug then

720 Can.VarDebug localHome name annotation

721 Can.VarDebug localHome name annotation

721 else

722 else

722 Can.VarForeign home name annotation

723 Can.VarForeign home name annotation

723

724

724− Just (Env.Ambiguous h hs) ->

725+ Just homes ->

725− Result.throw (Error.AmbiguousVar region (Just prefix) name h hs)

726+ Result.throw (Error.AmbiguousVar region (Just prefix) name (Map.keys homes))

726

727

727 Nothing ->

728 Nothing ->

728 Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))

729 Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))

compiler/src/Canonicalize/Module.hs+7−7

@@ -236,11 +236,11 @@ checkExposed

236 -> Map.Map Name.Name alias

237 -> Map.Map Name.Name binop

238 -> Can.Effects

239− -> Src.Exposed

239+ -> A.Located Src.Exposed

240 -> Result i w (Dups.Dict (A.Located Can.Export))

241−checkExposed values unions aliases binops effects exposed =

241+checkExposed values unions aliases binops effects (A.At region exposed) =

242 case exposed of

243− Src.Lower (A.At region name) ->

243+ Src.Lower name ->

244 if Map.member name values then

245 ok name region Can.ExportValue

246 else

@@ -252,23 +252,23 @@ checkExposed values unions aliases binops effects exposed =

252 Result.throw $ Error.ExportNotFound region Error.BadVar name $

253 ports ++ Map.keys values

254

255− Src.Operator region name ->

255+ Src.Operator name ->

256 if Map.member name binops then

257 ok name region Can.ExportBinop

258 else

259 Result.throw $ Error.ExportNotFound region Error.BadOp name $

260 Map.keys binops

261

262− Src.Upper (A.At region name) (Src.Public dotDotRegion) ->

262+ Src.Upper name Src.Public ->

263 if Map.member name unions then

264 ok name region Can.ExportUnionOpen

265 else if Map.member name aliases then

266− Result.throw $ Error.ExportOpenAlias dotDotRegion name

266+ Result.throw $ Error.ExportOpenAlias region name

267 else

268 Result.throw $ Error.ExportNotFound region Error.BadType name $

269 Map.keys unions ++ Map.keys aliases

270

271− Src.Upper (A.At region name) Src.Private ->

271+ Src.Upper name Src.Private ->

272 if Map.member name unions then

273 ok name region Can.ExportUnionClosed

274 else if Map.member name aliases then

compiler/src/Canonicalize/Pattern.hs+2−3

@@ -8,7 +8,6 @@ module Canonicalize.Pattern

8 where

11−import qualified Data.List as List

12import qualified Data.Map.Strict as Map

11import qualified Data.Map.Strict as Map

13import qualified Data.Name as Name

12import qualified Data.Name as Name

@@ -174,8 +173,8 @@ logVar name region value =

174logFields :: [A.Located Name.Name] -> a -> Result DupsDict w a

173logFields :: [A.Located Name.Name] -> a -> Result DupsDict w a

175logFields fields value =

174logFields fields value =

176 let

175 let

177− addField dict (A.At region name) =

176+ addField (A.At region name) dict =

178 Dups.insert name region region dict

177 Dups.insert name region region dict

179 in

178 in

180 Result.Result $ \bindings warnings _ ok ->

179 Result.Result $ \bindings warnings _ ok ->

181− ok (List.foldl' addField bindings fields) warnings value

180+ ok (foldr addField bindings fields) warnings value

compiler/src/Data/Name.hs+60−60

@@ -19,6 +19,7 @@ module Data.Name

19 , isAppendableType

20 , isCompappendType

21 , fromVarIndex

22+ , fromReplCount

22 , fromWords

23 , fromWords

23 , fromManyNames

24 , fromManyNames

24 , fromTypeVariable

25 , fromTypeVariable

@@ -31,7 +32,7 @@ module Data.Name

31 , shader, debug, debugger, bitwise, basics

32 , shader, debug, debugger, bitwise, basics

32 , utils, negate, true, false, value

33 , utils, negate, true, false, value

33 , node, program, _main, _Main, dollar, identity

34 , node, program, _main, _Main, dollar, identity

34− , replModule, replValueToPrint

35+ , replModule

35 )

36 )

36 where

37 where

@@ -44,14 +45,19 @@ import qualified Data.Coerce as Coerce

44import qualified Data.List as List

45import qualified Data.List as List

45import qualified Data.String as Chars

46import qualified Data.String as Chars

46import qualified Data.Utf8 as Utf8

47import qualified Data.Utf8 as Utf8

48+import Foreign.Ptr (plusPtr, minusPtr)

47import GHC.Exts

49import GHC.Exts

48− ( Int(I#), Ptr

50+ ( Int(I#), Ptr(Ptr)

51+ , RealWorld

49 , MutableByteArray#

52 , MutableByteArray#

50 , isTrue#

53 , isTrue#

51 , newByteArray#

54 , newByteArray#

52 , sizeofByteArray#

55 , sizeofByteArray#

56+ , writeWord8OffAddr#

57+ , copyByteArrayToAddr#

53 , unsafeFreezeByteArray#

58 , unsafeFreezeByteArray#

54 )

59 )

60+import GHC.IO

55import GHC.ST (ST(ST), runST)

61import GHC.ST (ST(ST), runST)

56import GHC.Prim

62import GHC.Prim

57import GHC.Word (Word8(W8#))

63import GHC.Word (Word8(W8#))

@@ -202,11 +208,11 @@ fromVarIndex :: Int -> Name

202fromVarIndex n =

208fromVarIndex n =

203 runST

209 runST

204 (

210 (

205− do let !size = 2 + getIndexSize n

211+ do let !size = getIndexSize n

206 mba <- newByteArray size

212 mba <- newByteArray size

207 writeWord8 mba 0 0x5F {- _ -}

213 writeWord8 mba 0 0x5F {- _ -}

208 writeWord8 mba 1 0x76 {- v -}

214 writeWord8 mba 1 0x76 {- v -}

209− writeDigitsAtEnd mba size n

215+ writeDigits mba (size - 1) n

210 freeze mba

216 freeze mba

211 )

217 )

212

218

@@ -214,20 +220,19 @@ fromVarIndex n =

214{-# INLINE getIndexSize #-}

220{-# INLINE getIndexSize #-}

215getIndexSize :: Int -> Int

221getIndexSize :: Int -> Int

216getIndexSize n

222getIndexSize n

217− | n < 10 = 1

223+ | n < 10 = 3

218− | n < 100 = 2

224+ | n < 100 = 4

219− | True = ceiling (logBase 10 (fromIntegral n + 1) :: Float)

225+ | True = 2 + ceiling (logBase 10 (fromIntegral n + 1) :: Float)

220

226

221

227

222

228

223−writeDigitsAtEnd :: MBA s -> Int -> Int -> ST s ()

229+writeDigits :: MBA s -> Int -> Int -> ST s ()

224−writeDigitsAtEnd !mba !oldOffset !n =

230+writeDigits !mba !offset !n =

225 do let (q,r) = quotRem n 10

231 do let (q,r) = quotRem n 10

226− let !newOffset = oldOffset - 1

232+ writeWord8 mba offset (0x30 + fromIntegral r)

227− writeWord8 mba newOffset (0x30 + fromIntegral r)

228 if q <= 0

233 if q <= 0

229 then return ()

234 then return ()

230− else writeDigitsAtEnd mba newOffset q

235+ else writeDigits mba (offset-1) q

231

236

232

237

233

238

@@ -250,7 +255,7 @@ fromTypeVariable name@(Utf8.Utf8 ba#) index =

250 mba <- newByteArray size

255 mba <- newByteArray size

251 copyToMBA name mba

256 copyToMBA name mba

252 writeWord8 mba (I# len#) 0x5F {- _ -}

257 writeWord8 mba (I# len#) 0x5F {- _ -}

253− writeDigitsAtEnd mba size index

258+ writeDigits mba (size - 1) index

254 freeze mba

259 freeze mba

255 )

260 )

256 else

261 else

@@ -259,7 +264,7 @@ fromTypeVariable name@(Utf8.Utf8 ba#) index =

259 do let !size = I# len# + getIndexSize index

264 do let !size = I# len# + getIndexSize index

260 mba <- newByteArray size

265 mba <- newByteArray size

261 copyToMBA name mba

266 copyToMBA name mba

262− writeDigitsAtEnd mba size index

267+ writeDigits mba (size - 1) index

263 freeze mba

268 freeze mba

264 )

269 )

265

270

@@ -278,61 +283,61 @@ fromTypeVariableScheme scheme =

278 freeze mba

283 freeze mba

279 else

284 else

280 do let (extra, letter) = quotRem scheme 26

285 do let (extra, letter) = quotRem scheme 26

281− let !size = 1 + getIndexSize extra

286+ let !size = getIndexSize extra

282 mba <- newByteArray size

287 mba <- newByteArray size

283 writeWord8 mba 0 (0x61 + fromIntegral letter)

288 writeWord8 mba 0 (0x61 + fromIntegral letter)

284− writeDigitsAtEnd mba size extra

289+ writeDigits mba (size - 1) extra

285 freeze mba

290 freeze mba

286 )

291 )

287

292

288

293

289

294

295+-- FROM REPL COUNT

296+

297+

298+fromReplCount :: Int -> Name

299+fromReplCount n =

300+ Utf8.fromChars ("repl_value_" ++ show n)

301+

302+

303+

290-- FROM MANY NAMES

304-- 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)

300

305

301

306

302fromManyNames :: [Name] -> Name

307fromManyNames :: [Name] -> Name

303fromManyNames names =

308fromManyNames names =

304− case names of

309+ let

305− [] ->

310+ !(I# size#) = sum (map (\(Utf8.Utf8 ba#) -> I# (sizeofByteArray# ba# +# 1#)) names)

306− blank

311+ in

307− -- NOTE: this case is needed for (let _ = Debug.log "x" x in ...)

312+ runST

308− -- but maybe unused patterns should be stripped out instead

313+ (

309−

314+ ST $ \s ->

310− Utf8.Utf8 ba# : _ ->

315+ case newByteArray# size# s of

311− let

316+ (# s, mba# #) ->

312− len# = sizeofByteArray# ba#

317+ case writeNames mba# 0# names s of

313− in

318+ s ->

314− runST

319+ case unsafeFreezeByteArray# mba# s of

315− (

320+ (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)

316− ST $ \s ->

321+ )

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

322

331

323

332−{-# NOINLINE blank #-}

324+writeNames :: MutableByteArray# s -> Int# -> [Name] -> State# s -> State# s

333−blank :: Name

325+writeNames mba# !offset# names s =

334−blank =

326+ case names of

335− fromWords [0x5F,0x4D,0x24] {-_M$-}

327+ [] ->

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

336

341

337

342

338

343

@@ -603,8 +608,3 @@ identity = fromChars "identity"

603{-# NOINLINE replModule #-}

608{-# NOINLINE replModule #-}

604replModule :: Name

609replModule :: Name

605replModule = fromChars "Elm_Repl"

610replModule = fromChars "Elm_Repl"

606−

607−

608−{-# NOINLINE replValueToPrint #-}

609−replValueToPrint :: Name

610−replValueToPrint = fromChars "repl_input_value_"

compiler/src/Data/NonEmptyList.hs+2−6

@@ -52,12 +52,8 @@ instance Foldable List where

52-- SORT BY

55−sortBy :: (Ord b) => (a -> b) -> List a -> List a

55+sortBy :: (a -> a -> Ordering) -> List a -> List a

56−sortBy toRank (List x xs) =

56+sortBy comparison (List x xs) =

57− let

58− comparison a b =

59− compare (toRank a) (toRank b)

60− in

61 case List.sortBy comparison xs of

57 case List.sortBy comparison xs of

62 [] ->

58 [] ->

63 List x []

59 List x []

compiler/src/Data/Utf8.hs+4−6

@@ -63,7 +63,7 @@ import GHC.Exts

63import GHC.IO

64import GHC.ST (ST(ST), runST)

65import GHC.Prim

66−import GHC.Word (Word8(W8#))

66+import GHC.Word (Word8(W8#), Word16(W16#))

68import qualified Parse.Primitives as P

@@ -261,9 +261,7 @@ instance Eq (Utf8 t) where

261

262

263-- COMPARE

264−--

264+

265−-- TODO: is it fine to sort by length and only compare bytes on length ties?

266−--

267

265

268instance Ord (Utf8 t) where

266instance Ord (Utf8 t) where

269 compare (Utf8 ba1#) (Utf8 ba2#) =

267 compare (Utf8 ba1#) (Utf8 ba2#) =

@@ -457,7 +455,7 @@ toEscapedBuilderHelp before after !name@(Utf8 ba#) k =

457 !bLen = minusPtr bEnd bOffset

455 !bLen = minusPtr bEnd bOffset

458 in

456 in

459 if len <= bLen then

457 if len <= bLen then

460− do -- PERF test if writing word-by-word is faster

458+ do -- TODO test if writing word-by-word is faster

461 copyToPtr name offset bOffset len

459 copyToPtr name offset bOffset len

462 escape before after bOffset name offset len 0

460 escape before after bOffset name offset len 0

463 let !newBufferRange = B.BufferRange (plusPtr bOffset len) bEnd

461 let !newBufferRange = B.BufferRange (plusPtr bOffset len) bEnd

@@ -567,7 +565,7 @@ data MBA s =

567 MBA# (MutableByteArray# s)

565 MBA# (MutableByteArray# s)

568

566

569

567

570−newByteArray :: Int -> ST s (MBA s) -- PERF see if newPinnedByteArray for len > 256 is positive

568+newByteArray :: Int -> ST s (MBA s) -- TODO see if newPinnedByteArray for len > 256 is positive

571newByteArray (I# len#) =

569newByteArray (I# len#) =

572 ST $ \s ->

570 ST $ \s ->

573 case newByteArray# len# s of

571 case newByteArray# len# s of

compiler/src/Elm/Compiler/Imports.hs+3−3

@@ -49,14 +49,14 @@ closed =

50typeOpen :: Name.Name -> Src.Exposing

51typeOpen name =

52− Src.Explicit [ Src.Upper (A.At A.zero name) (Src.Public A.zero) ]

52+ Src.Explicit [ A.At A.zero (Src.Upper name Src.Public) ]

55typeClosed :: Name.Name -> Src.Exposing

56typeClosed name =

57− Src.Explicit [ Src.Upper (A.At A.zero name) Src.Private ]

57+ Src.Explicit [ A.At A.zero (Src.Upper name Src.Private) ]

60operator :: Name.Name -> Src.Exposing

61operator op =

62− Src.Explicit [ Src.Operator A.zero op ]

62+ Src.Explicit [ A.At A.zero (Src.Operator op) ]

compiler/src/Elm/Compiler/Type/Extract.hs+1−1

@@ -87,7 +87,7 @@ toPublicName (ModuleName.Canonical _ home) name =

88newtype Types =

89 Types (Map.Map ModuleName.Canonical Types_)

90− -- PERF profile Opt.Global representation

90+ -- TODO profile Opt.Global representation

91 -- current representation needs less allocation

92 -- but maybe the lookup is much worse

compiler/src/Elm/Constraint.hs+1−1

@@ -216,7 +216,7 @@ instance Binary Op where

216 case n of

217 0 -> return Less

218 1 -> return LessOrEqual

219− _ -> fail "binary encoding of Op was corrupted"

219+ _ -> error "binary encoding of Op was corrupted"

220

221

222

compiler/src/Elm/Docs.hs+158−218

@@ -1,7 +1,8 @@

1{-# OPTIONS_GHC -Wall #-}

2−{-# LANGUAGE BangPatterns, MultiWayIf, OverloadedStrings, UnboxedTuples #-}

2+{-# LANGUAGE OverloadedStrings #-}

3module Elm.Docs

4 ( Documentation

5+ , toDict

5 , Module(..)

6 , Module(..)

6 , fromModule

7 , fromModule

7 , Union(..)

8 , Union(..)

@@ -17,35 +18,33 @@ module Elm.Docs

17 where

18 where

20−import qualified Data.Coerce as Coerce

21+import qualified Data.ByteString as B

21import qualified Data.List as List

22import qualified Data.List as List

22import Data.Map ((!))

23import Data.Map ((!))

23import qualified Data.Map as Map

24import qualified Data.Map as Map

24−import qualified Data.Map.Merge.Strict as Map

25import qualified Data.Name as Name

26−import qualified Data.NonEmptyList as NE

26+import qualified Data.Text as Text

27−import qualified Data.OneOrMore as OneOrMore

27+import qualified Data.Text.Encoding as Text

28−import Data.Word (Word8)

29−import Foreign.Ptr (Ptr, plusPtr)

31import qualified AST.Canonical as Can

29import qualified AST.Canonical as Can

32−import qualified AST.Source as Src

33import qualified AST.Utils.Binop as Binop

30import qualified AST.Utils.Binop as Binop

31+import qualified Data.OneOrMore as OneOrMore

34import qualified Elm.Compiler.Type as Type

32import qualified Elm.Compiler.Type as Type

35import qualified Elm.Compiler.Type.Extract as Extract

33import qualified Elm.Compiler.Type.Extract as Extract

36import qualified Elm.ModuleName as ModuleName

34import qualified Elm.ModuleName as ModuleName

37import qualified Json.Decode as D

35import qualified Json.Decode as D

38import qualified Json.Encode as E

36import qualified Json.Encode as E

39import Json.Encode ((==>))

37import Json.Encode ((==>))

40−import qualified Json.String as Json

41−import Parse.Primitives (Row, Col, word1)

42−import qualified Parse.Primitives as P

43−import qualified Parse.Space as Space

44−import qualified Parse.Symbol as Symbol

45−import qualified Parse.Variable as Var

46import qualified Reporting.Annotation as A

38import qualified Reporting.Annotation as A

39+import qualified Reporting.Error as Error

47import qualified Reporting.Error.Docs as E

40import qualified Reporting.Error.Docs as E

41+import qualified Reporting.Region as R

48import qualified Reporting.Result as Result

42import qualified Reporting.Result as Result

43+import Parse.Primitives (Parser)

44+import qualified Parse.Primitives as P

45+import qualified Parse.Primitives.Symbol as Symbol

46+import qualified Parse.Primitives.Variable as Var

47+import qualified Parse.Primitives.Whitespace as W

@@ -56,6 +55,21 @@ type Documentation =

56 Map.Map Name.Name Module

55 Map.Map Name.Name Module

58+toDict :: [Module] -> Documentation

59+toDict modules =

60+ Map.fromList (map toPair modules)

61+

62+

63+

64+toPair :: Module -> (Name.Name, Module)

65+toPair modul@(Module name _ _ _ _ _) =

66+ (name, modul)

67+

68+

69+

70+-- MODULES

71+

72+

59data Module =

73data Module =

60 Module

74 Module

61 { _name :: Name.Name

75 { _name :: Name.Name

@@ -66,7 +80,9 @@ data Module =

66 , _binops :: Map.Map Name.Name Binop

80 , _binops :: Map.Map Name.Name Binop

67 }

81 }

69−type Comment = Json.String

83+

84+type Comment = Text.Text

85+

71data Alias = Alias Comment [Name.Name] Type.Type

87data Alias = Alias Comment [Name.Name] Type.Type

72data Union = Union Comment [Name.Name] [(Name.Name, [Type.Type])]

88data Union = Union Comment [Name.Name] [(Name.Name, [Type.Type])]

@@ -75,19 +91,14 @@ data Binop = Binop Comment Type.Type Binop.Associativity Binop.Precedence

78−-- JSON

94+-- JSON ENCODE / DECODE

79−

80−

81−encode :: Documentation -> E.Value

82−encode docs =

83− E.list encodeModule (Map.elems docs)

86−encodeModule :: Module -> E.Value

97+encode :: Module -> E.Value

87−encodeModule (Module name comment unions aliases values binops) =

98+encode (Module name comment unions aliases values binops) =

88 E.object $

99 E.object $

89 [ "name" ==> ModuleName.encode name

100 [ "name" ==> ModuleName.encode name

90− , "comment" ==> E.string comment

101+ , "comment" ==> E.text comment

91 , "unions" ==> E.list encodeUnion (Map.toList unions)

102 , "unions" ==> E.list encodeUnion (Map.toList unions)

92 , "aliases" ==> E.list encodeAlias (Map.toList aliases)

103 , "aliases" ==> E.list encodeAlias (Map.toList aliases)

93 , "values" ==> E.list encodeValue (Map.toList values)

104 , "values" ==> E.list encodeValue (Map.toList values)

@@ -96,31 +107,16 @@ encodeModule (Module name comment unions aliases values binops) =

107

108

98data Error

109data Error

99− = BadAssociativity

110+ = BadAssociativity Text.Text

100− | BadModuleName

111+ | BadName

101 | BadType

112 | BadType

102

113

103

114

104−decoder :: D.Decoder Error Documentation

115+decoder :: D.Decoder Error Module

105decoder =

116decoder =

106− toDict <$> D.list moduleDecoder

107−

108−

109−toDict :: [Module] -> Documentation

110−toDict modules =

111− Map.fromList (map toDictHelp modules)

112−

113−

114−toDictHelp :: Module -> (Name.Name, Module)

115−toDictHelp modul@(Module name _ _ _ _ _) =

116− (name, modul)

117−

118−

119−moduleDecoder :: D.Decoder Error Module

120−moduleDecoder =

121 Module

117 Module

122− <$> D.field "name" moduleNameDecoder

118+ <$> D.field "name" nameDecoder

123− <*> D.field "comment" D.string

119+ <*> D.field "comment" D.text

124 <*> D.field "unions" (dictDecoder union)

120 <*> D.field "unions" (dictDecoder union)

125 <*> D.field "aliases" (dictDecoder alias)

121 <*> D.field "aliases" (dictDecoder alias)

126 <*> D.field "values" (dictDecoder value)

122 <*> D.field "values" (dictDecoder value)

@@ -135,18 +131,13 @@ dictDecoder entryDecoder =

135named :: D.Decoder Error a -> D.Decoder Error (Name.Name, a)

131named :: D.Decoder Error a -> D.Decoder Error (Name.Name, a)

136named entryDecoder =

132named entryDecoder =

137 (,)

133 (,)

138− <$> D.field "name" nameDecoder

134+ <$> D.field "name" D.name

139 <*> entryDecoder

135 <*> entryDecoder

140

136

141

137

142−nameDecoder :: D.Decoder e Name.Name

138+nameDecoder :: D.Decoder Error Name.Name

143nameDecoder =

139nameDecoder =

144− fmap Coerce.coerce D.string

140+ D.mapError (const BadName) ModuleName.decoder

145−

146−

147−moduleNameDecoder :: D.Decoder Error ModuleName.Raw

148−moduleNameDecoder =

149− D.mapError (const BadModuleName) ModuleName.decoder

150

141

151

142

152typeDecoder :: D.Decoder Error Type.Type

143typeDecoder :: D.Decoder Error Type.Type

@@ -162,7 +153,7 @@ encodeUnion :: (Name.Name, Union) -> E.Value

162encodeUnion (name, Union comment args cases) =

153encodeUnion (name, Union comment args cases) =

163 E.object

154 E.object

164 [ "name" ==> E.name name

155 [ "name" ==> E.name name

165− , "comment" ==> E.string comment

156+ , "comment" ==> E.text comment

166 , "args" ==> E.list E.name args

157 , "args" ==> E.list E.name args

167 , "cases" ==> E.list encodeCase cases

158 , "cases" ==> E.list encodeCase cases

168 ]

159 ]

@@ -171,8 +162,8 @@ encodeUnion (name, Union comment args cases) =

171union :: D.Decoder Error Union

162union :: D.Decoder Error Union

172union =

163union =

173 Union

164 Union

174− <$> D.field "comment" D.string

165+ <$> D.field "comment" D.text

175− <*> D.field "args" (D.list nameDecoder)

166+ <*> D.field "args" (D.list D.name)

176 <*> D.field "cases" (D.list caseDecoder)

167 <*> D.field "cases" (D.list caseDecoder)

177

168

178

169

@@ -183,7 +174,7 @@ encodeCase ( tag, args ) =

183

174

184caseDecoder :: D.Decoder Error ( Name.Name, [Type.Type] )

175caseDecoder :: D.Decoder Error ( Name.Name, [Type.Type] )

185caseDecoder =

176caseDecoder =

186− D.pair nameDecoder (D.list typeDecoder)

177+ D.pair D.name (D.list typeDecoder)

187

178

188

179

189

180

@@ -194,7 +185,7 @@ encodeAlias :: (Name.Name, Alias) -> E.Value

194encodeAlias ( name, Alias comment args tipe) =

185encodeAlias ( name, Alias comment args tipe) =

195 E.object

186 E.object

196 [ "name" ==> E.name name

187 [ "name" ==> E.name name

197− , "comment" ==> E.string comment

188+ , "comment" ==> E.text comment

198 , "args" ==> E.list E.name args

189 , "args" ==> E.list E.name args

199 , "type" ==> Type.encode tipe

190 , "type" ==> Type.encode tipe

200 ]

191 ]

@@ -203,8 +194,8 @@ encodeAlias ( name, Alias comment args tipe) =

203alias :: D.Decoder Error Alias

194alias :: D.Decoder Error Alias

204alias =

195alias =

205 Alias

196 Alias

206− <$> D.field "comment" D.string

197+ <$> D.field "comment" D.text

207− <*> D.field "args" (D.list nameDecoder)

198+ <*> D.field "args" (D.list D.name)

208 <*> D.field "type" typeDecoder

199 <*> D.field "type" typeDecoder

209

200

210

201

@@ -216,7 +207,7 @@ encodeValue :: (Name.Name, Value) -> E.Value

216encodeValue (name, Value comment tipe) =

207encodeValue (name, Value comment tipe) =

217 E.object

208 E.object

218 [ "name" ==> E.name name

209 [ "name" ==> E.name name

219− , "comment" ==> E.string comment

210+ , "comment" ==> E.text comment

220 , "type" ==> Type.encode tipe

211 , "type" ==> Type.encode tipe

221 ]

212 ]

222

213

@@ -224,7 +215,7 @@ encodeValue (name, Value comment tipe) =

224value :: D.Decoder Error Value

215value :: D.Decoder Error Value

225value =

216value =

226 Value

217 Value

227− <$> D.field "comment" D.string

218+ <$> D.field "comment" D.text

228 <*> D.field "type" typeDecoder

219 <*> D.field "type" typeDecoder

229

220

230

221

@@ -236,7 +227,7 @@ encodeBinop :: (Name.Name, Binop) -> E.Value

236encodeBinop (name, Binop comment tipe assoc prec) =

227encodeBinop (name, Binop comment tipe assoc prec) =

237 E.object

228 E.object

238 [ "name" ==> E.name name

229 [ "name" ==> E.name name

239− , "comment" ==> E.string comment

230+ , "comment" ==> E.text comment

240 , "type" ==> Type.encode tipe

231 , "type" ==> Type.encode tipe

241 , "associativity" ==> encodeAssoc assoc

232 , "associativity" ==> encodeAssoc assoc

242 , "precedence" ==> encodePrec prec

233 , "precedence" ==> encodePrec prec

@@ -246,7 +237,7 @@ encodeBinop (name, Binop comment tipe assoc prec) =

246binop :: D.Decoder Error Binop

237binop :: D.Decoder Error Binop

247binop =

238binop =

248 Binop

239 Binop

249− <$> D.field "comment" D.string

240+ <$> D.field "comment" D.text

250 <*> D.field "type" typeDecoder

241 <*> D.field "type" typeDecoder

251 <*> D.field "associativity" assocDecoder

242 <*> D.field "associativity" assocDecoder

252 <*> D.field "precedence" precDecoder

243 <*> D.field "precedence" precDecoder

@@ -259,23 +250,19 @@ binop =

259encodeAssoc :: Binop.Associativity -> E.Value

250encodeAssoc :: Binop.Associativity -> E.Value

260encodeAssoc assoc =

251encodeAssoc assoc =

261 case assoc of

252 case assoc of

262− Binop.Left -> E.chars "left"

253+ Binop.Left -> E.text "left"

263− Binop.Non -> E.chars "non"

254+ Binop.Non -> E.text "non"

264− Binop.Right -> E.chars "right"

255+ Binop.Right -> E.text "right"

265

256

266

257

267assocDecoder :: D.Decoder Error Binop.Associativity

258assocDecoder :: D.Decoder Error Binop.Associativity

268assocDecoder =

259assocDecoder =

269− let

260+ do txt <- D.text

270− left = Json.fromChars "left"

261+ case txt of

271− non = Json.fromChars "non"

262+ "left" -> D.succeed Binop.Left

272− right = Json.fromChars "right"

263+ "non" -> D.succeed Binop.Non

273− in

264+ "right" -> D.succeed Binop.Right

274− do str <- D.string

265+ _ -> D.fail (BadAssociativity txt)

275− if | str == left -> return Binop.Left

276− | str == non -> return Binop.Non

277− | str == right -> return Binop.Right

278− | otherwise -> D.failure BadAssociativity

279

266

280

267

281

268

@@ -296,190 +283,142 @@ precDecoder =

296-- FROM MODULE

283-- FROM MODULE

297

284

298

285

299−fromModule :: Can.Module -> Either E.Error Module

286+fromModule :: Can.Module -> Result.Result i w Error.Error Module

300−fromModule modul@(Can.Module _ exports docs _ _ _ _ _) =

287+fromModule (Can.Module name docs exports decls unions aliases binops effects) =

301 case exports of

288 case exports of

302 Can.ExportEverything region ->

289 Can.ExportEverything region ->

303− Left (E.ImplicitExposing region)

290+ Result.throw $ Error.Docs $ E.ImplicitExposing region

304

291

305 Can.Export exportDict ->

292 Can.Export exportDict ->

306 case docs of

293 case docs of

307− Src.NoDocs region ->

294+ Can.NoDocs region ->

308− Left (E.NoDocs region)

295+ Result.throw $ Error.Docs $ E.NoDocs region

309

296

310− Src.YesDocs overview comments ->

297+ Can.YesDocs region overview comments ->

311− do names <- parseOverview overview

298+ do names <- parseOverview region overview

312− checkNames exportDict names

299+ Result.mapError Error.Docs $

313− checkDefs exportDict overview (Map.fromList comments) modul

300+ do checkNames exportDict names

301+ let types = gatherTypes decls Map.empty

302+ let info = Info comments types unions aliases binops effects

303+ inserters <- Map.traverseWithKey (checkExport info) exportDict

304+ return $ foldr ($) (emptyModule name overview) inserters

305+

306+

307+emptyModule :: ModuleName.Canonical -> B.ByteString -> Module

308+emptyModule (ModuleName.Canonical _ name) overview =

309+ Module name (Text.decodeUtf8 overview) Map.empty Map.empty Map.empty Map.empty

314

310

315

311

316

312

317-- PARSE OVERVIEW

313-- PARSE OVERVIEW

318

314

319

315

320−parseOverview :: Src.Comment -> Either E.Error [A.Located Name.Name]

316+parseOverview :: R.Region -> B.ByteString -> Result.Result i w Error.Error [A.Located Name.Name]

321−parseOverview (Src.Comment snippet) =

317+parseOverview (R.Region (R.Position row col) _) overview =

322− case P.fromSnippet (chompOverview []) E.BadEnd snippet of

318+ case P.runAt row (col + 3) (chompOverview []) overview of

323 Left err ->

319 Left err ->

324− Left (E.SyntaxProblem err)

320+ Result.throw (Error.Syntax err)

325

321

326 Right names ->

322 Right names ->

327− Right names

323+ Result.ok names

328−

329−

330−type Parser a =

331− P.Parser E.SyntaxProblem a

332

324

333

325

334chompOverview :: [A.Located Name.Name] -> Parser [A.Located Name.Name]

326chompOverview :: [A.Located Name.Name] -> Parser [A.Located Name.Name]

335chompOverview names =

327chompOverview names =

336− do isDocs <- chompUntilDocs

328+ do isDocs <- W.chompUntilDocs

337 if isDocs

329 if isDocs

338− then

330+ then chompOverviewHelp names

339− do Space.chomp E.Space

331+ else return names

340− chompOverview =<< chompDocs names

332+

341− else

333+

342− return names

334+chompOverviewHelp :: [A.Located Name.Name] -> Parser [A.Located Name.Name]

335+chompOverviewHelp names =

336+ do pos <- P.getPosition

337+ (W.SPos spos) <- W.whitespace

338+ if pos == spos

339+ then chompOverview names

340+ else chompOverview =<< chompDocs names

343

341

344

342

345chompDocs :: [A.Located Name.Name] -> Parser [A.Located Name.Name]

343chompDocs :: [A.Located Name.Name] -> Parser [A.Located Name.Name]

346chompDocs names =

344chompDocs names =

347− do name <-

345+ do name <- P.addLocation (P.oneOf [ Var.lower, Var.upper, chompBinop ])

348− P.addLocation $

346+ spos <- W.whitespace

349− P.oneOf E.Name

347+ P.oneOf

350− [ Var.lower E.Name

348+ [ do P.checkSpace spos

351− , Var.upper E.Name

349+ Symbol.comma

352− , chompOperator

350+ P.spaces

353− ]

354−

355− Space.chomp E.Space

356−

357− P.oneOfWithFallback

358− [ do pos <- P.getPosition

359− Space.checkIndent pos E.Comma

360− word1 0x2C {-,-} E.Comma

361− Space.chomp E.Space

362 chompDocs (name:names)

351 chompDocs (name:names)

352+ , return (name:names)

363 ]

353 ]

364− (name:names)

354+

365−

355+

366−

356+chompBinop :: Parser Name.Name

367−chompOperator :: Parser Name.Name

357+chompBinop =

368−chompOperator =

358+ do Symbol.leftParen

369− do word1 0x28 {-(-} E.Op

359+ name <- Symbol.binop

370− op <- Symbol.operator E.Op E.OpBad

360+ Symbol.rightParen

371− word1 0x29 {-)-} E.Op

361+ return name

372− return op

373−

374−

375−-- TODO add rule that @docs must be after newline in 0.20

376−--

377−chompUntilDocs :: Parser Bool

378−chompUntilDocs =

379− P.Parser $ \(P.State src pos end indent row col) cok _ _ _ ->

380− let

381− (# isDocs, newPos, newRow, newCol #) = untilDocs pos end row col

382− !newState = P.State src newPos end indent newRow newCol

383− in

384− cok isDocs newState

385−

386−

387−untilDocs :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Bool, Ptr Word8, Row, Col #)

388−untilDocs pos end row col =

389− if pos >= end then

390− (# False, pos, row, col #)

391− else

392− let !word = P.unsafeIndex pos in

393− if word == 0x0A {-\n-} then

394− untilDocs (plusPtr pos 1) end (row + 1) 1

395− else

396− let !pos5 = plusPtr pos 5 in

397− if pos5 <= end

398− && P.unsafeIndex ( pos ) == 0x40 {-@-}

399− && P.unsafeIndex (plusPtr pos 1) == 0x64 {-d-}

400− && P.unsafeIndex (plusPtr pos 2) == 0x6F {-o-}

401− && P.unsafeIndex (plusPtr pos 3) == 0x63 {-c-}

402− && P.unsafeIndex (plusPtr pos 4) == 0x73 {-s-}

403− && Var.getInnerWidth pos5 end == 0

404− then

405− (# True, pos5, row, col + 5 #)

406− else

407− let !newPos = plusPtr pos (P.getCharWidth word) in

408− untilDocs newPos end row (col + 1)

409

362

410

363

411

364

412-- CHECK NAMES

365-- CHECK NAMES

413

366

414

367

415−checkNames :: Map.Map Name.Name (A.Located Can.Export) -> [A.Located Name.Name] -> Either E.Error ()

368+type Result i w a =

416−checkNames exports names =

369+ Result.Result i w E.Error a

417− let

370+

418− docs = List.foldl' addName Map.empty names

371+

419− loneDoc = Map.traverseMissing onlyInDocs

372+type Dups =

420− loneExport = Map.traverseMissing onlyInExports

373+ Map.Map Name.Name (OneOrMore.OneOrMore R.Region)

421− checkBoth = Map.zipWithAMatched (\n _ r -> isUnique n r)

422− in

423− case Result.run (Map.mergeA loneExport loneDoc checkBoth exports docs) of

424− (_, Right _) -> Right ()

425− (_, Left es) -> Left (E.NameProblems (OneOrMore.destruct NE.List es))

426

374

427

375

428−type DocNameRegions =

376+checkNames :: Map.Map Name.Name (A.Located Can.Export) -> [A.Located Name.Name] -> Result i w ()

429− Map.Map Name.Name (OneOrMore.OneOrMore A.Region)

377+checkNames exports names =

378+ do docs <- Map.traverseWithKey isUnique (List.foldl' addName Map.empty names)

379+ let overlap = Map.size (Map.intersection docs exports)

380+ if Map.size exports == overlap && overlap == Map.size docs

381+ then Result.ok ()

382+ else

383+ do _ <- Map.traverseWithKey onlyInDocs (Map.difference docs exports)

384+ _ <- Map.traverseWithKey onlyInExports (Map.difference exports docs)

385+ Result.ok ()

430

386

431

387

432−addName :: DocNameRegions -> A.Located Name.Name -> DocNameRegions

388+addName :: Dups -> A.Located Name.Name -> Dups

433addName dict (A.At region name) =

389addName dict (A.At region name) =

434 Map.insertWith OneOrMore.more name (OneOrMore.one region) dict

390 Map.insertWith OneOrMore.more name (OneOrMore.one region) dict

435

391

436

392

437−isUnique :: Name.Name -> OneOrMore.OneOrMore A.Region -> Result.Result i w E.NameProblem A.Region

393+isUnique :: Name.Name -> OneOrMore.OneOrMore R.Region -> Result i w R.Region

438isUnique name regions =

394isUnique name regions =

439 case regions of

395 case regions of

440 OneOrMore.One region ->

396 OneOrMore.One region ->

441 Result.ok region

397 Result.ok region

442

398

443− OneOrMore.More left right ->

399+ OneOrMore.More _ _ ->

444− let (r1, r2) = OneOrMore.getFirstTwo left right in

400+ let (r1:r2:_) = OneOrMore.toList regions in

445− Result.throw (E.NameDuplicate name r1 r2)

401+ Result.throw (E.Duplicate name r1 r2)

446

402

447

403

448−onlyInDocs :: Name.Name -> OneOrMore.OneOrMore A.Region -> Result.Result i w E.NameProblem a

404+onlyInDocs :: Name.Name -> R.Region -> Result i w a

449−onlyInDocs name regions =

405+onlyInDocs name region =

450− do region <- isUnique name regions

406+ Result.throw $ E.OnlyInDocs name region

451− Result.throw $ E.NameOnlyInDocs name region

452

407

453

408

454−onlyInExports :: Name.Name -> A.Located Can.Export -> Result.Result i w E.NameProblem a

409+onlyInExports :: Name.Name -> A.Located Can.Export -> Result i w a

455onlyInExports name (A.At region _) =

410onlyInExports name (A.At region _) =

456− Result.throw $ E.NameOnlyInExports name region

411+ Result.throw $ E.OnlyInExports name region

457−

458−

459−

460−-- CHECK DEFS

461−

462

412

463−checkDefs :: Map.Map Name.Name (A.Located Can.Export) -> Src.Comment -> Map.Map Name.Name Src.Comment -> Can.Module -> Either E.Error Module

464−checkDefs exportDict overview comments (Can.Module name _ _ decls unions aliases infixes effects) =

465− let

466− types = gatherTypes decls Map.empty

467− info = Info comments types unions aliases infixes effects

468− in

469− case Result.run (Map.traverseWithKey (checkExport info) exportDict) of

470− (_, Left problems ) -> Left $ E.DefProblems (OneOrMore.destruct NE.List problems)

471− (_, Right inserters) -> Right $ foldr ($) (emptyModule name overview) inserters

472

413

473

414

474−emptyModule :: ModuleName.Canonical -> Src.Comment -> Module

415+-- CHECK EXPORTS

475−emptyModule (ModuleName.Canonical _ name) (Src.Comment overview) =

476− Module name (Json.fromComment overview) Map.empty Map.empty Map.empty Map.empty

477

416

478

417

479data Info =

418data Info =

480 Info

419 Info

481− { _iComments :: Map.Map Name.Name Src.Comment

420+ { _iComments :: Map.Map Name.Name Comment

482− , _iValues :: Map.Map Name.Name (Either A.Region Can.Type)

421+ , _iValues :: Types

483 , _iUnions :: Map.Map Name.Name Can.Union

422 , _iUnions :: Map.Map Name.Name Can.Union

484 , _iAliases :: Map.Map Name.Name Can.Alias

423 , _iAliases :: Map.Map Name.Name Can.Alias

485 , _iBinops :: Map.Map Name.Name Can.Binop

424 , _iBinops :: Map.Map Name.Name Can.Binop

@@ -487,7 +426,7 @@ data Info =

487 }

426 }

488

427

489

428

490−checkExport :: Info -> Name.Name -> A.Located Can.Export -> Result.Result i w E.DefProblem (Module -> Module)

429+checkExport :: Info -> Name.Name -> A.Located Can.Export -> Result i w (Module -> Module)

491checkExport info name (A.At region export) =

430checkExport info name (A.At region export) =

492 case export of

431 case export of

493 Can.ExportValue ->

432 Can.ExportValue ->

@@ -528,23 +467,23 @@ checkExport info name (A.At region export) =

528 m { _values = Map.insert name (Value comment tipe) (_values m) }

467 m { _values = Map.insert name (Value comment tipe) (_values m) }

529

468

530

469

531−getComment :: A.Region -> Name.Name -> Info -> Result.Result i w E.DefProblem Comment

470+getComment :: R.Region -> Name.Name -> Info -> Result i w Comment

532getComment region name info =

471getComment region name info =

533 case Map.lookup name (_iComments info) of

472 case Map.lookup name (_iComments info) of

534 Nothing ->

473 Nothing ->

535 Result.throw (E.NoComment name region)

474 Result.throw (E.NoComment name region)

536

475

537− Just (Src.Comment snippet) ->

476+ Just comment ->

538− Result.ok (Json.fromComment snippet)

477+ Result.ok comment

539

478

540

479

541−getType :: Name.Name -> Info -> Result.Result i w E.DefProblem Type.Type

480+getType :: Name.Name -> Info -> Result i w Type.Type

542getType name info =

481getType name info =

543 case _iValues info ! name of

482 case _iValues info ! name of

544− Left region ->

483+ A.At defRegion Nothing ->

545− Result.throw (E.NoAnnotation name region)

484+ Result.throw (E.NoAnnotation name defRegion)

546

485

547− Right tipe ->

486+ A.At _ (Just tipe) ->

548 Result.ok (Extract.fromType tipe)

487 Result.ok (Extract.fromType tipe)

549

488

550

489

@@ -558,7 +497,7 @@ dector (Can.Ctor name _ _ args) =

558

497

559

498

560type Types =

499type Types =

561− Map.Map Name.Name (Either A.Region Can.Type)

500+ Map.Map Name.Name (A.Located (Maybe Can.Type))

562

501

563

502

564gatherTypes :: Can.Decls -> Types -> Types

503gatherTypes :: Can.Decls -> Types -> Types

@@ -567,8 +506,8 @@ gatherTypes decls types =

567 Can.Declare def subDecls ->

506 Can.Declare def subDecls ->

568 gatherTypes subDecls (addDef types def)

507 gatherTypes subDecls (addDef types def)

569

508

570− Can.DeclareRec def defs subDecls ->

509+ Can.DeclareRec defs subDecls ->

571− gatherTypes subDecls (List.foldl' addDef (addDef types def) defs)

510+ gatherTypes subDecls (List.foldl' addDef types defs)

572

511

573 Can.SaveTheEnvironment ->

512 Can.SaveTheEnvironment ->

574 types

513 types

@@ -578,10 +517,11 @@ addDef :: Types -> Can.Def -> Types

578addDef types def =

517addDef types def =

579 case def of

518 case def of

580 Can.Def (A.At region name) _ _ ->

519 Can.Def (A.At region name) _ _ ->

581− Map.insert name (Left region) types

520+ Map.insert name (A.At region Nothing) types

582

521

583− Can.TypedDef (A.At _ name) _ typedArgs _ resultType ->

522+ Can.TypedDef (A.At region name) _ typedArgs _ resultType ->

584 let

523 let

585− tipe = foldr Can.TLambda resultType (map snd typedArgs)

524+ tipe =

525+ foldr Can.TLambda resultType (map snd typedArgs)

586 in

526 in

587− Map.insert name (Right tipe) types

527+ Map.insert name (A.At region (Just tipe)) types

compiler/src/Elm/Interface.hs+3−3

@@ -215,7 +215,7 @@ instance Binary Union where

215 0 -> liftM OpenUnion get

216 1 -> liftM ClosedUnion get

217 2 -> liftM PrivateUnion get

218− _ -> fail "binary encoding of Union was corrupted"

218+ _ -> error "binary encoding of Union was corrupted"

219

220

221instance Binary Alias where

@@ -229,7 +229,7 @@ instance Binary Alias where

229 case n of

230 0 -> liftM PublicAlias get

231 1 -> liftM PrivateAlias get

232− _ -> fail "binary encoding of Alias was corrupted"

232+ _ -> error "binary encoding of Alias was corrupted"

233

234

235instance Binary Binop where

@@ -251,4 +251,4 @@ instance Binary DependencyInterface where

251 case n of

252 0 -> liftM Public get

253 1 -> liftM3 Private get get get

254− _ -> fail "binary encoding of DependencyInterface was corrupted"

254+ _ -> error "binary encoding of DependencyInterface was corrupted"

compiler/src/Elm/Kernel.hs+10−10

@@ -15,7 +15,7 @@ import qualified Data.ByteString.Internal as B

15import qualified Data.List as List

16import qualified Data.Map as Map

17import qualified Data.Name as Name

18−import Data.Word (Word8)

18+import Data.Word (Word8, Word16)

19import Foreign.Ptr (Ptr, plusPtr, minusPtr)

20import Foreign.ForeignPtr (ForeignPtr)

21import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

@@ -128,7 +128,7 @@ parseChunks vtable enums fields =

128 cerr row col toError

129

130

131−chompChunks :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Row, Col #)

131+chompChunks :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)

132chompChunks vs es fs src pos end row col lastPos revChunks =

133 if pos >= end then

134 let !js = toByteString src lastPos end in

@@ -152,7 +152,7 @@ chompChunks vs es fs src pos end row col lastPos revChunks =

152

153 else

154 let

155− !newPos = plusPtr pos (getCharWidth word)

155+ !newPos = plusPtr pos (getCharWidth pos end word)

156 in

157 chompChunks vs es fs src newPos end row (col + 1) lastPos revChunks

158

@@ -168,7 +168,7 @@ toByteString src pos end =

168

169

170-- relies on external checks in chompChunks

171−chompTag :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> [Chunk] -> (# [Chunk], Ptr Word8, Row, Col #)

171+chompTag :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)

172chompTag vs es fs src pos end row col revChunks =

173 let

174 (# newPos, newCol #) = Var.chompInnerChars pos end col

@@ -319,19 +319,19 @@ toNames exposing =

319 map toName exposedList

320

321

322−toName :: Src.Exposed -> Name.Name

322+toName :: A.Located Src.Exposed -> Name.Name

323−toName exposed =

323+toName (A.At _ exposed) =

324 case exposed of

325− Src.Lower (A.At _ name) ->

325+ Src.Lower name ->

326 name

327

328− Src.Upper (A.At _ name) Src.Private ->

328+ Src.Upper name Src.Private ->

329 name

330

331− Src.Upper _ (Src.Public _) ->

331+ Src.Upper _ Src.Public ->

332 error "cannot have Maybe(..) syntax in kernel code header"

333

334− Src.Operator _ _ ->

334+ Src.Operator _ ->

335 error "cannot use binops in kernel code"

336

337

compiler/src/Elm/Licenses.hs+25−25

@@ -83,61 +83,63 @@ check givenCode =

83osiApprovedSpdxLicenses :: Map.Map Json.String [Char]

84osiApprovedSpdxLicenses =

85 Map.fromList

86− [ "0BSD" ==> "BSD Zero Clause License"

86+ [ "AFL-1.1" ==> "Academic Free License v1.1"

87− , "AAL" ==> "Attribution Assurance License"

88− , "AFL-1.1" ==> "Academic Free License v1.1"

89 , "AFL-1.2" ==> "Academic Free License v1.2"

87 , "AFL-1.2" ==> "Academic Free License v1.2"

90 , "AFL-2.0" ==> "Academic Free License v2.0"

88 , "AFL-2.0" ==> "Academic Free License v2.0"

91 , "AFL-2.1" ==> "Academic Free License v2.1"

89 , "AFL-2.1" ==> "Academic Free License v2.1"

92 , "AFL-3.0" ==> "Academic Free License v3.0"

90 , "AFL-3.0" ==> "Academic Free License v3.0"

93− , "AGPL-3.0" ==> "GNU Affero General Public License v3.0"

91+ , "APL-1.0" ==> "Adaptive Public License 1.0"

94 , "Apache-1.1" ==> "Apache License 1.1"

92 , "Apache-1.1" ==> "Apache License 1.1"

95 , "Apache-2.0" ==> "Apache License 2.0"

93 , "Apache-2.0" ==> "Apache License 2.0"

96− , "APL-1.0" ==> "Adaptive Public License 1.0"

97 , "APSL-1.0" ==> "Apple Public Source License 1.0"

94 , "APSL-1.0" ==> "Apple Public Source License 1.0"

98 , "APSL-1.1" ==> "Apple Public Source License 1.1"

95 , "APSL-1.1" ==> "Apple Public Source License 1.1"

99 , "APSL-1.2" ==> "Apple Public Source License 1.2"

96 , "APSL-1.2" ==> "Apple Public Source License 1.2"

100 , "APSL-2.0" ==> "Apple Public Source License 2.0"

97 , "APSL-2.0" ==> "Apple Public Source License 2.0"

101 , "Artistic-1.0" ==> "Artistic License 1.0"

98 , "Artistic-1.0" ==> "Artistic License 1.0"

102− , "Artistic-1.0-cl8" ==> "Artistic License 1.0 w/clause 8"

103 , "Artistic-1.0-Perl" ==> "Artistic License 1.0 (Perl)"

99 , "Artistic-1.0-Perl" ==> "Artistic License 1.0 (Perl)"

100+ , "Artistic-1.0-cl8" ==> "Artistic License 1.0 w/clause 8"

104 , "Artistic-2.0" ==> "Artistic License 2.0"

101 , "Artistic-2.0" ==> "Artistic License 2.0"

102+ , "AAL" ==> "Attribution Assurance License"

103+ , "BSL-1.0" ==> "Boost Software License 1.0"

105 , "BSD-2-Clause" ==> "BSD 2-clause \"Simplified\" License"

104 , "BSD-2-Clause" ==> "BSD 2-clause \"Simplified\" License"

106 , "BSD-3-Clause" ==> "BSD 3-clause \"New\" or \"Revised\" License"

105 , "BSD-3-Clause" ==> "BSD 3-clause \"New\" or \"Revised\" License"

107− , "BSL-1.0" ==> "Boost Software License 1.0"

106+ , "0BSD" ==> "BSD Zero Clause License"

108− , "CATOSL-1.1" ==> "Computer Associates Trusted Open Source License 1.1"

109− , "CDDL-1.0" ==> "Common Development and Distribution License 1.0"

110 , "CECILL-2.1" ==> "CeCILL Free Software License Agreement v2.1"

107 , "CECILL-2.1" ==> "CeCILL Free Software License Agreement v2.1"

111 , "CNRI-Python" ==> "CNRI Python License"

108 , "CNRI-Python" ==> "CNRI Python License"

109+ , "CDDL-1.0" ==> "Common Development and Distribution License 1.0"

112 , "CPAL-1.0" ==> "Common Public Attribution License 1.0"

110 , "CPAL-1.0" ==> "Common Public Attribution License 1.0"

113 , "CPL-1.0" ==> "Common Public License 1.0"

111 , "CPL-1.0" ==> "Common Public License 1.0"

112+ , "CATOSL-1.1" ==> "Computer Associates Trusted Open Source License 1.1"

114 , "CUA-OPL-1.0" ==> "CUA Office Public License v1.0"

113 , "CUA-OPL-1.0" ==> "CUA Office Public License v1.0"

114+ , "EPL-1.0" ==> "Eclipse Public License 1.0"

115 , "ECL-1.0" ==> "Educational Community License v1.0"

116 , "ECL-2.0" ==> "Educational Community License v2.0"

117 , "EFL-1.0" ==> "Eiffel Forum License v1.0"

118 , "EFL-2.0" ==> "Eiffel Forum License v2.0"

119 , "Entessa" ==> "Entessa Public License v1.0"

120− , "EPL-1.0" ==> "Eclipse Public License 1.0"

121 , "EUDatagrid" ==> "EU DataGrid Software License"

120 , "EUDatagrid" ==> "EU DataGrid Software License"

122 , "EUPL-1.1" ==> "European Union Public License 1.1"

121 , "EUPL-1.1" ==> "European Union Public License 1.1"

123 , "Fair" ==> "Fair License"

122 , "Fair" ==> "Fair License"

124 , "Frameworx-1.0" ==> "Frameworx Open License 1.0"

123 , "Frameworx-1.0" ==> "Frameworx Open License 1.0"

124+ , "AGPL-3.0" ==> "GNU Affero General Public License v3.0"

125 , "GPL-2.0" ==> "GNU General Public License v2.0 only"

126 , "GPL-3.0" ==> "GNU General Public License v3.0 only"

127+ , "LGPL-2.1" ==> "GNU Lesser General Public License v2.1 only"

128+ , "LGPL-3.0" ==> "GNU Lesser General Public License v3.0 only"

129+ , "LGPL-2.0" ==> "GNU Library General Public License v2 only"

127 , "HPND" ==> "Historic Permission Notice and Disclaimer"

130 , "HPND" ==> "Historic Permission Notice and Disclaimer"

131+ , "IPL-1.0" ==> "IBM Public License v1.0"

128 , "Intel" ==> "Intel Open Source License"

132 , "Intel" ==> "Intel Open Source License"

129 , "IPA" ==> "IPA Font License"

133 , "IPA" ==> "IPA Font License"

130− , "IPL-1.0" ==> "IBM Public License v1.0"

131 , "ISC" ==> "ISC License"

134 , "ISC" ==> "ISC License"

132− , "LGPL-2.0" ==> "GNU Library General Public License v2 only"

135+ , "LPPL-1.3c" ==> "LaTeX Project Public License v1.3c"

133− , "LGPL-2.1" ==> "GNU Lesser General Public License v2.1 only"

134− , "LGPL-3.0" ==> "GNU Lesser General Public License v3.0 only"

135 , "LiLiQ-P-1.1" ==> "Licence Libre du Québec – Permissive version 1.1"

136 , "LiLiQ-P-1.1" ==> "Licence Libre du Québec – Permissive version 1.1"

136− , "LiLiQ-R-1.1" ==> "Licence Libre du Québec – Réciprocité version 1.1"

137 , "LiLiQ-Rplus-1.1" ==> "Licence Libre du Québec – Réciprocité forte version 1.1"

138− , "LPL-1.0" ==> "Lucent Public License Version 1.0"

138+ , "LiLiQ-R-1.1" ==> "Licence Libre du Québec – Réciprocité version 1.1"

139 , "LPL-1.02" ==> "Lucent Public License v1.02"

140− , "LPPL-1.3c" ==> "LaTeX Project Public License v1.3c"

140+ , "LPL-1.0" ==> "Lucent Public License Version 1.0"

141+ , "MS-PL" ==> "Microsoft Public License"

142+ , "MS-RL" ==> "Microsoft Reciprocal License"

141 , "MirOS" ==> "MirOS Licence"

143 , "MirOS" ==> "MirOS Licence"

142 , "MIT" ==> "MIT License"

144 , "MIT" ==> "MIT License"

143 , "Motosoto" ==> "Motosoto License"

145 , "Motosoto" ==> "Motosoto License"

@@ -145,40 +147,38 @@ osiApprovedSpdxLicenses =

145 , "MPL-1.1" ==> "Mozilla Public License 1.1"

147 , "MPL-1.1" ==> "Mozilla Public License 1.1"

146 , "MPL-2.0" ==> "Mozilla Public License 2.0"

148 , "MPL-2.0" ==> "Mozilla Public License 2.0"

147 , "MPL-2.0-no-copyleft-exception" ==> "Mozilla Public License 2.0 (no copyleft exception)"

149 , "MPL-2.0-no-copyleft-exception" ==> "Mozilla Public License 2.0 (no copyleft exception)"

148− , "MS-PL" ==> "Microsoft Public License"

149− , "MS-RL" ==> "Microsoft Reciprocal License"

150 , "Multics" ==> "Multics License"

151 , "NASA-1.3" ==> "NASA Open Source Agreement 1.3"

152 , "Naumen" ==> "Naumen Public License"

153− , "NCSA" ==> "University of Illinois/NCSA Open Source License"

154 , "NGPL" ==> "Nethack General Public License"

153 , "NGPL" ==> "Nethack General Public License"

155 , "Nokia" ==> "Nokia Open Source License"

154 , "Nokia" ==> "Nokia Open Source License"

156 , "NPOSL-3.0" ==> "Non-Profit Open Software License 3.0"

155 , "NPOSL-3.0" ==> "Non-Profit Open Software License 3.0"

157 , "NTP" ==> "NTP License"

156 , "NTP" ==> "NTP License"

158 , "OCLC-2.0" ==> "OCLC Research Public License 2.0"

157 , "OCLC-2.0" ==> "OCLC Research Public License 2.0"

159− , "OFL-1.1" ==> "SIL Open Font License 1.1"

160 , "OGTSL" ==> "Open Group Test Suite License"

158 , "OGTSL" ==> "Open Group Test Suite License"

161− , "OSET-PL-2.1" ==> "OSET Public License version 2.1"

162 , "OSL-1.0" ==> "Open Software License 1.0"

159 , "OSL-1.0" ==> "Open Software License 1.0"

163 , "OSL-2.0" ==> "Open Software License 2.0"

160 , "OSL-2.0" ==> "Open Software License 2.0"

164 , "OSL-2.1" ==> "Open Software License 2.1"

161 , "OSL-2.1" ==> "Open Software License 2.1"

165 , "OSL-3.0" ==> "Open Software License 3.0"

162 , "OSL-3.0" ==> "Open Software License 3.0"

163+ , "OSET-PL-2.1" ==> "OSET Public License version 2.1"

166 , "PHP-3.0" ==> "PHP License v3.0"

164 , "PHP-3.0" ==> "PHP License v3.0"

167 , "PostgreSQL" ==> "PostgreSQL License"

165 , "PostgreSQL" ==> "PostgreSQL License"

168 , "Python-2.0" ==> "Python License 2.0"

166 , "Python-2.0" ==> "Python License 2.0"

169 , "QPL-1.0" ==> "Q Public License 1.0"

167 , "QPL-1.0" ==> "Q Public License 1.0"

168+ , "RPSL-1.0" ==> "RealNetworks Public Source License v1.0"

170 , "RPL-1.1" ==> "Reciprocal Public License 1.1"

169 , "RPL-1.1" ==> "Reciprocal Public License 1.1"

171 , "RPL-1.5" ==> "Reciprocal Public License 1.5"

170 , "RPL-1.5" ==> "Reciprocal Public License 1.5"

172− , "RPSL-1.0" ==> "RealNetworks Public Source License v1.0"

173 , "RSCPL" ==> "Ricoh Source Code Public License"

171 , "RSCPL" ==> "Ricoh Source Code Public License"

172+ , "OFL-1.1" ==> "SIL Open Font License 1.1"

174 , "SimPL-2.0" ==> "Simple Public License 2.0"

173 , "SimPL-2.0" ==> "Simple Public License 2.0"

175− , "SISSL" ==> "Sun Industry Standards Source License v1.1"

176 , "Sleepycat" ==> "Sleepycat License"

174 , "Sleepycat" ==> "Sleepycat License"

175+ , "SISSL" ==> "Sun Industry Standards Source License v1.1"

177 , "SPL-1.0" ==> "Sun Public License v1.0"

176 , "SPL-1.0" ==> "Sun Public License v1.0"

177+ , "Watcom-1.0" ==> "Sybase Open Watcom Public License 1.0"

178 , "UPL-1.0" ==> "Universal Permissive License v1.0"

179+ , "NCSA" ==> "University of Illinois/NCSA Open Source License"

179 , "VSL-1.0" ==> "Vovida Software License v1.0"

180 , "VSL-1.0" ==> "Vovida Software License v1.0"

180 , "W3C" ==> "W3C Software Notice and License (2002-12-31)"

181 , "W3C" ==> "W3C Software Notice and License (2002-12-31)"

181− , "Watcom-1.0" ==> "Sybase Open Watcom Public License 1.0"

182 , "Xnet" ==> "X.Net License"

183 , "Zlib" ==> "zlib License"

184 , "ZPL-2.0" ==> "Zope Public License 2.0"

compiler/src/Elm/ModuleName.hs+7−2

@@ -7,13 +7,12 @@ module Elm.ModuleName

7 --

8 , encode

9 , decoder

10− , parser

11 --

10 --

12 , Canonical(..)

11 , Canonical(..)

13 , basics, char, string

12 , basics, char, string

14 , maybe, result, list, array, dict, tuple

13 , maybe, result, list, array, dict, tuple

15 , platform, cmd, sub

14 , platform, cmd, sub

16− , debug

15+ , debug, bitwise

17 , virtualDom

16 , virtualDom

18 , jsonDecode, jsonEncode

17 , jsonDecode, jsonEncode

19 , webgl, texture, vector2, vector3, vector4, matrix4

18 , webgl, texture, vector2, vector3, vector4, matrix4

@@ -23,6 +22,7 @@ module Elm.ModuleName

24import Control.Monad (liftM2)

23import Control.Monad (liftM2)

25import Data.Binary (Binary(..))

24import Data.Binary (Binary(..))

25+import qualified Data.Char as Char

26import qualified Data.Name as Name

27import qualified Data.Utf8 as Utf8

28import Data.Word (Word8)

@@ -226,6 +226,11 @@ debug :: Canonical

226debug = Canonical Pkg.core Name.debug

227

228

229+{-# NOINLINE bitwise #-}

230+bitwise :: Canonical

231+bitwise = Canonical Pkg.core Name.bitwise

232+

233+

229

234

230-- HTML

235-- HTML

231

236

compiler/src/Elm/Package.hs+15−5

@@ -31,6 +31,7 @@ module Elm.Package

31import Control.Monad (liftM2)

32import Data.Binary (Binary, get, put)

33import qualified Data.Coerce as Coerce

34+import Data.Function (on)

34import qualified Data.List as List

35import qualified Data.List as List

35import qualified Data.Map as Map

36import qualified Data.Map as Map

36import qualified Data.Name as Name

37import qualified Data.Name as Name

@@ -58,7 +59,6 @@ data Name =

58 { _author :: !Author

59 { _author :: !Author

59 , _project :: !Project

60 , _project :: !Project

60 }

61 }

61− deriving (Ord)

64type Author = Utf8.Utf8 AUTHOR

@@ -236,10 +236,12 @@ nearbyNames (Name author1 project1) possibleNames =

236 authorDist = authorDistance (Utf8.toChars author1)

237 projectDist = projectDistance (Utf8.toChars project1)

238

239− nameDistance (Name author2 project2) =

239+ addDistance name@(Name author2 project2) =

240− authorDist author2 + projectDist project2

240+ ( authorDist author2 + projectDist project2, name )

241 in

242− take 4 $ List.sortOn nameDistance possibleNames

242+ map snd $ take 4 $

243+ List.sortBy (compare `on` fst) $

244+ map addDistance possibleNames

243

245

244

246

245authorDistance :: [Char] -> Author -> Int

247authorDistance :: [Char] -> Author -> Int

@@ -268,11 +270,19 @@ instance Eq Canonical where

268 version1 == version2 && package1 == package2

270 version1 == version2 && package1 == package2

269

271

270

272

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+

271

281

272-- BINARY

282-- BINARY

273

283

274

284

275−instance Binary Name where -- PERF try storing as a Word16

285+instance Binary Name where -- TODO try storing as a Word16

276 get = liftM2 Name Utf8.getUnder256 Utf8.getUnder256

286 get = liftM2 Name Utf8.getUnder256 Utf8.getUnder256

277 put (Name a b) = Utf8.putUnder256 a >> Utf8.putUnder256 b

287 put (Name a b) = Utf8.putUnder256 a >> Utf8.putUnder256 b

278

288

compiler/src/Elm/String.hs+1

@@ -108,6 +108,7 @@ writeChunks mba offset chunks =

108 writeChunks mba newOffset chunks

109

110

111+-- TODO see if it is faster to writeWord32 a block of hex-as-ascii

111writeCode :: MBA RealWorld -> Int -> Int -> ST RealWorld ()

112writeCode :: MBA RealWorld -> Int -> Int -> ST RealWorld ()

112writeCode mba offset code =

113writeCode mba offset code =

113 do writeWord8 mba offset 0x5C {- \ -}

114 do writeWord8 mba offset 0x5C {- \ -}

compiler/src/Generate/Html.hs+10−11

@@ -29,23 +29,22 @@ sandwich moduleName javascript =

30<body>

32−<pre id="elm"></pre>

32+<pre id="elm">

33+This is a headless program, meaning there is nothing to show here.

34+

35+I started the program anyway though!

36+

37+You can access it as `app` in the developer console.

38+</pre>

34<script>

40<script>

35−try {

36|] <> javascript <> [r|

41|] <> javascript <> [r|

43+try {

38 var app = Elm.|] <> name <> [r|.init({ node: document.getElementById("elm") });

44 var app = Elm.|] <> name <> [r|.init({ node: document.getElementById("elm") });

39−}

45+} catch (e) {

40−catch (e)

41−{

42 // display initialization errors (e.g. bad flags, infinite recursion)

46 // display initialization errors (e.g. bad flags, infinite recursion)

43− var header = document.createElement("h1");

47+ document.getElementById("elm").innerText = e;

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;

49 throw e;

48 throw e;

50}

49}

51</script>

50</script>

compiler/src/Generate/JavaScript.hs+19−51

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

2module Generate.JavaScript

3 ( generate

4 , generateForRepl

5− , generateForReplEndpoint

6 )

5 )

7 where

6 where

@@ -86,9 +85,7 @@ generateForRepl ansi localizer (Opt.GlobalGraph graph _) home name (Can.Forall _

86 debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug "toString")

85 debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug "toString")

87 evalState = addGlobal mode graph debugState (Opt.Global home name)

86 evalState = addGlobal mode graph debugState (Opt.Global home name)

88 in

87 in

89− "process.on('uncaughtException', function(err) { process.stderr.write(err.toString() + '\\n'); process.exit(1); });"

88+ stateToBuilder evalState

90− <> Functions.functions

91− <> stateToBuilder evalState

92 <> print ansi localizer home name tipe

89 <> print ansi localizer home name tipe

@@ -100,47 +97,14 @@ print ansi localizer home name tipe =

100 tipeDoc = RT.canToDoc localizer RT.None tipe

97 tipeDoc = RT.canToDoc localizer RT.None tipe

101 bool = if ansi then "true" else "false"

98 bool = if ansi then "true" else "false"

102 in

99 in

103− "var _value = " <> toString <> "(" <> bool <> ", " <> value <> ");\n\

100+ "var _value = " <> toString <> "(" <> bool <> ", " <> value <> ");\n\

104− \var _type = " <> B.stringUtf8 (show (D.toString tipeDoc)) <> ";\n\

101+ \var _type = " <> B.stringUtf8 (show (D.toString tipeDoc)) <> ";\n\

105− \function _print(t) { console.log(_value + (" <> bool <> " ? '\x1b[90m' + t + '\x1b[0m' : t)); }\n\

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

103+ \if (_value.length + 3 + _type.length >= 80 || _type.indexOf('\\n') >= 0) {\n\

107− \ _print('\\n : ' + _type.split('\\n').join('\\n '));\n\

104+ \ _print('\\n : ' + _type.split('\\n').join('\\n '));\n\

108− \} else {\n\

105+ \} else {\n\

109− \ _print(' : ' + _type);\n\

106+ \ _print(' : ' + _type);\n\

110− \}\n"

107+ \}\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"

144

108

145

109

146

110

@@ -292,7 +256,7 @@ generateCycle mode (Opt.Global home _) names values functions =

292 "Some top-level definitions from `" <> Name.toBuilder (ModuleName._module home) <> "` are causing infinite recursion:\\n"

256 "Some top-level definitions from `" <> Name.toBuilder (ModuleName._module home) <> "` are causing infinite recursion:\\n"

293 <> drawCycle names

257 <> drawCycle names

294 <> "\\n\\nThese errors are very tricky, so read "

258 <> "\\n\\nThese errors are very tricky, so read "

295− <> B.stringUtf8 (D.makeNakedLink "bad-recursion")

259+ <> B.stringUtf8 (D.makeNakedLink "halting-problem")

296 <> " to learn how to fix it!"

260 <> " to learn how to fix it!"

297 ]

261 ]

298

262

@@ -350,7 +314,7 @@ addChunk :: Mode.Mode -> K.Chunk -> B.Builder -> B.Builder

350addChunk mode chunk builder =

314addChunk mode chunk builder =

351 case chunk of

315 case chunk of

352 K.JS javascript ->

316 K.JS javascript ->

353− B.byteString javascript <> builder

317+ Utf8.toBuilder javascript <> builder

354

318

355 K.ElmVar home name ->

319 K.ElmVar home name ->

356 JsName.toBuilder (JsName.fromGlobal home name) <> builder

320 JsName.toBuilder (JsName.fromGlobal home name) <> builder

@@ -534,7 +498,7 @@ generateExports mode (Trie maybeMain subs) =

534 <> List.foldl' (addSubTrie mode) "}" otherSubTries

498 <> List.foldl' (addSubTrie mode) "}" otherSubTries

535

499

536

500

537−addSubTrie :: Mode.Mode -> B.Builder -> (Name.Name, Trie) -> B.Builder

501+addSubTrie :: Mode.Mode -> B.Builder -> (Utf8.String, Trie) -> B.Builder

538addSubTrie mode end (name, trie) =

502addSubTrie mode end (name, trie) =

539 ",'" <> Utf8.toBuilder name <> "':" <> generateExports mode trie <> end

503 ",'" <> Utf8.toBuilder name <> "':" <> generateExports mode trie <> end

540

504

@@ -546,7 +510,7 @@ addSubTrie mode end (name, trie) =

546data Trie =

510data Trie =

547 Trie

511 Trie

548 { _main :: Maybe (ModuleName.Canonical, Opt.Main)

512 { _main :: Maybe (ModuleName.Canonical, Opt.Main)

549− , _subs :: Map.Map Name.Name Trie

513+ , _subs :: Map.Map Utf8.String Trie

550 }

514 }

551

515

552

516

@@ -557,10 +521,14 @@ emptyTrie =

557

521

558addToTrie :: ModuleName.Canonical -> Opt.Main -> Trie -> Trie

522addToTrie :: ModuleName.Canonical -> Opt.Main -> Trie -> Trie

559addToTrie home@(ModuleName.Canonical _ moduleName) main trie =

523addToTrie home@(ModuleName.Canonical _ moduleName) main trie =

560− merge trie $ segmentsToTrie home (Name.splitDots moduleName) main

524+ let

525+ segments =

526+ Utf8.split 0x2E {-.-} (Name.toUtf8 moduleName)

527+ in

528+ merge trie $ segmentsToTrie home segments main

561

529

562

530

563−segmentsToTrie :: ModuleName.Canonical -> [Name.Name] -> Opt.Main -> Trie

531+segmentsToTrie :: ModuleName.Canonical -> [Utf8.String] -> Opt.Main -> Trie

564segmentsToTrie home segments main =

532segmentsToTrie home segments main =

565 case segments of

533 case segments of

566 [] ->

534 [] ->

compiler/src/Generate/JavaScript/Builder.hs−13

@@ -28,19 +28,6 @@ import qualified Json.Encode as Json

28-- EXPRESSIONS

31−-- NOTE: I tried making this create a B.Builder directly.

32−--

33−-- The hope was that it'd allocate less and speed things up, but it seemed

34−-- to be neutral for perf.

35−--

36−-- The downside is that Generate.JavaScript.Expression inspects the

37−-- structure of Expr and Stmt on some occassions to try to strip out

38−-- unnecessary closures. I think these closures are already avoided

39−-- by other logic in code gen these days, but I am not 100% certain.

40−--

41−-- For this to be worth it, I think it would be necessary to avoid

42−-- returning tuples when generating expressions.

43−--

44data Expr

31data Expr

45 = String Builder

32 = String Builder

46 | Float Builder

33 | Float Builder

compiler/src/Generate/JavaScript/Expression.hs+3−5

@@ -22,7 +22,6 @@ import qualified Data.Utf8 as Utf8

23import qualified AST.Canonical as Can

24import qualified AST.Optimized as Opt

25−import qualified AST.Utils.Shader as Shader

26import qualified Data.Index as Index

25import qualified Data.Index as Index

27import qualified Elm.Compiler.Type as Type

26import qualified Elm.Compiler.Type as Type

28import qualified Elm.Compiler.Type.Extract as Extract

27import qualified Elm.Compiler.Type.Extract as Extract

@@ -33,7 +32,6 @@ import qualified Generate.JavaScript.Builder as JS

33import qualified Generate.JavaScript.Name as JsName

32import qualified Generate.JavaScript.Name as JsName

34import qualified Generate.Mode as Mode

33import qualified Generate.Mode as Mode

35import qualified Json.Encode as Encode

34import qualified Json.Encode as Encode

36−import Json.Encode ((==>))

37import qualified Optimize.DecisionTree as DT

35import qualified Optimize.DecisionTree as DT

38import qualified Reporting.Annotation as A

36import qualified Reporting.Annotation as A

@@ -191,7 +189,7 @@ generate mode expression =

191 JS.Object (map toTranlation (Set.toList fields))

189 JS.Object (map toTranlation (Set.toList fields))

192 in

190 in

193 JsExpr $ JS.Object $

191 JsExpr $ JS.Object $

194− [ ( JsName.fromLocal "src", JS.String (Shader.toJsStringBuilder src) )

192+ [ ( JsName.fromLocal "src", JS.String (Utf8.toBuilder src) )

195 , ( JsName.fromLocal "attributes", toTranslationObject attributes )

193 , ( JsName.fromLocal "attributes", toTranslationObject attributes )

196 , ( JsName.fromLocal "uniforms", toTranslationObject uniforms )

194 , ( JsName.fromLocal "uniforms", toTranslationObject uniforms )

197 ]

195 ]

@@ -1065,6 +1063,6 @@ toDebugMetadata mode msgType =

1065

1063

1066 Mode.Dev (Just interfaces) ->

1064 Mode.Dev (Just interfaces) ->

1067 JS.Json $ Encode.object $

1065 JS.Json $ Encode.object $

1068− [ "versions" ==> Encode.object [ "elm" ==> V.encode V.compiler ]

1066+ [ ("versions", Encode.object [ ("elm", V.encode V.compiler) ])

1069− , "types" ==> Type.encodeMetadata (Extract.fromMsg interfaces msgType)

1067+ , ("types", Type.encodeMetadata (Extract.fromMsg interfaces msgType))

1070 ]

1068 ]

compiler/src/Generate/JavaScript/Name.hs+12−22

@@ -62,13 +62,19 @@ fromLocal name =

64fromGlobal :: ModuleName.Canonical -> Name.Name -> Name

65−fromGlobal home name =

65+fromGlobal (ModuleName.Canonical (Pkg.Name author project) home) name =

66− Name $ homeToBuilder home <> usd <> Name.toBuilder name

66+ Name $ Name.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} author

67+ <> "$" <> Name.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} project

68+ <> "$" <> Name.toEscapedBuilder 0x2E {- . -} 0x24 {- $ -} home

69+ <> "$" <> Name.toBuilder name

69fromCycle :: ModuleName.Canonical -> Name.Name -> Name

72fromCycle :: ModuleName.Canonical -> Name.Name -> Name

70−fromCycle home name =

73+fromCycle (ModuleName.Canonical (Pkg.Name author project) home) name =

71− Name $ homeToBuilder home <> "$cyclic$" <> Name.toBuilder name

74+ Name $ Name.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} author

75+ <> "$" <> Name.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} project

76+ <> "$" <> Name.toEscapedBuilder 0x2E {- . -} 0x24 {- $ -} home

77+ <> "$cyclic$" <> Name.toBuilder name

74fromKernel :: Name.Name -> Name.Name -> Name

80fromKernel :: Name.Name -> Name.Name -> Name

@@ -76,17 +82,6 @@ fromKernel home name =

76 Name ("_" <> Name.toBuilder home <> "_" <> Name.toBuilder name)

82 Name ("_" <> Name.toBuilder home <> "_" <> Name.toBuilder name)

79−{-# INLINE homeToBuilder #-}

80−homeToBuilder :: ModuleName.Canonical -> B.Builder

81−homeToBuilder (ModuleName.Canonical (Pkg.Name author project) home) =

82− usd <>

83− Utf8.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} author

84− <> usd <>

85− Utf8.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} project

86− <> usd <>

87− Utf8.toEscapedBuilder 0x2E {- . -} 0x24 {- $ -} home

88−

89−

91-- TEMPORARY NAMES

86-- TEMPORARY NAMES

@@ -103,7 +98,7 @@ makeA n =

103

104makeLabel :: Name.Name -> Int -> Name

99makeLabel :: Name.Name -> Int -> Name

105makeLabel name index =

100makeLabel name index =

106− Name (Name.toBuilder name <> usd <> B.intDec index)

101+ Name (Name.toBuilder name <> "$" <> B.intDec index)

107

102

108

103

109makeTemp :: Name.Name -> Name

104makeTemp :: Name.Name -> Name

@@ -113,12 +108,7 @@ makeTemp name =

113

108

114dollar :: Name

109dollar :: Name

115dollar =

110dollar =

116− Name usd

111+ Name (Name.toBuilder Name.dollar)

117−

118−

119−usd :: B.Builder

120−usd =

121− Name.toBuilder Name.dollar

122

112

123

113

124

114

compiler/src/Generate/Mode.hs+1

@@ -49,6 +49,7 @@ shortenFieldNames (Opt.GlobalGraph _ frequencies) =

50addToBuckets :: Name.Name -> Int -> Map.Map Int [Name.Name] -> Map.Map Int [Name.Name]

51addToBuckets field frequency buckets =

52+ -- TODO try using an IntMap for buckets

52 Map.insertWith (++) frequency [field] buckets

53 Map.insertWith (++) frequency [field] buckets

compiler/src/Json/Decode.hs+73−78

@@ -24,7 +24,6 @@ module Json.Decode

24 , Problem(..)

25 , DecodeExpectation(..)

26 , ParseError(..)

27− , StringProblem(..)

28 )

27 )

29 where

28 where

@@ -32,7 +31,7 @@ module Json.Decode

32import qualified Data.ByteString.Internal as B

31import qualified Data.ByteString.Internal as B

33import qualified Data.Map as Map

32import qualified Data.Map as Map

34import qualified Data.NonEmptyList as NE

33import qualified Data.NonEmptyList as NE

35−import Data.Word (Word8)

34+import Data.Word (Word8, Word16)

36import Foreign.Ptr (Ptr, plusPtr, minusPtr)

35import Foreign.Ptr (Ptr, plusPtr, minusPtr)

37import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

36import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

@@ -40,7 +39,6 @@ import qualified Json.String as Json

40import qualified Parse.Keyword as K

39import qualified Parse.Keyword as K

41import qualified Parse.Primitives as P

40import qualified Parse.Primitives as P

42import Parse.Primitives (Row, Col)

41import Parse.Primitives (Row, Col)

43−import qualified Reporting.Annotation as A

@@ -51,10 +49,10 @@ fromByteString :: Decoder x a -> B.ByteString -> Either (Error x) a

51fromByteString (Decoder decode) src =

49fromByteString (Decoder decode) src =

52 case P.fromByteString pFile BadEnd src of

50 case P.fromByteString pFile BadEnd src of

53 Right ast ->

51 Right ast ->

54− decode ast Right (Left . DecodeProblem src)

52+ decode ast Right (Left . DecodeProblem)

56 Left problem ->

54 Left problem ->

57− Left (ParseProblem src problem)

55+ Left (ParseProblem problem)

@@ -77,8 +75,8 @@ newtype Decoder x a =

79data Error x

77data Error x

80− = DecodeProblem B.ByteString (Problem x)

78+ = DecodeProblem (Problem x)

81− | ParseProblem B.ByteString ParseError

79+ | ParseProblem ParseError

@@ -89,8 +87,8 @@ data Problem x

89 = Field B.ByteString (Problem x)

87 = Field B.ByteString (Problem x)

90 | Index Int (Problem x)

88 | Index Int (Problem x)

91 | OneOf (Problem x) [Problem x]

89 | OneOf (Problem x) [Problem x]

92− | Failure A.Region x

90+ | Failure x

93− | Expecting A.Region DecodeExpectation

91+ | Expecting DecodeExpectation

96data DecodeExpectation

94data DecodeExpectation

@@ -157,26 +155,26 @@ instance Monad (Decoder x) where

157

155

158string :: Decoder x Json.String

156string :: Decoder x Json.String

159string =

157string =

160− Decoder $ \(A.At region ast) ok err ->

158+ Decoder $ \ast ok err ->

161 case ast of

159 case ast of

162 String snippet ->

160 String snippet ->

163 ok (Json.fromSnippet snippet)

161 ok (Json.fromSnippet snippet)

164

162

165 _ ->

163 _ ->

166− err (Expecting region TString)

164+ err (Expecting TString)

167

165

168

166

169customString :: P.Parser x a -> (Row -> Col -> x) -> Decoder x a

167customString :: P.Parser x a -> (Row -> Col -> x) -> Decoder x a

170customString parser toBadEnd =

168customString parser toBadEnd =

171− Decoder $ \(A.At region ast) ok err ->

169+ Decoder $ \ast ok err ->

172 case ast of

170 case ast of

173 String snippet ->

171 String snippet ->

174 case P.fromSnippet parser toBadEnd snippet of

172 case P.fromSnippet parser toBadEnd snippet of

175 Right a -> ok a

173 Right a -> ok a

176− Left x -> err (Failure region x)

174+ Left x -> err (Failure x)

177

175

178 _ ->

176 _ ->

179− err (Expecting region TString)

177+ err (Expecting TString)

180

178

181

179

182

180

@@ -185,7 +183,7 @@ customString parser toBadEnd =

185

183

186bool :: Decoder x Bool

184bool :: Decoder x Bool

187bool =

185bool =

188− Decoder $ \(A.At region ast) ok err ->

186+ Decoder $ \ast ok err ->

189 case ast of

187 case ast of

190 TRUE ->

188 TRUE ->

191 ok True

189 ok True

@@ -194,7 +192,7 @@ bool =

194 ok False

192 ok False

195

193

196 _ ->

194 _ ->

197− err (Expecting region TBool)

195+ err (Expecting TBool)

198

196

199

197

200

198

@@ -203,13 +201,13 @@ bool =

203

201

204int :: Decoder x Int

202int :: Decoder x Int

205int =

203int =

206− Decoder $ \(A.At region ast) ok err ->

204+ Decoder $ \ast ok err ->

207 case ast of

205 case ast of

208 Int n ->

206 Int n ->

209 ok n

207 ok n

210

208

211 _ ->

209 _ ->

212− err (Expecting region TInt)

210+ err (Expecting TInt)

213

211

214

212

215

213

@@ -218,13 +216,13 @@ int =

218

216

219list :: Decoder x a -> Decoder x [a]

217list :: Decoder x a -> Decoder x [a]

220list decoder =

218list decoder =

221− Decoder $ \(A.At region ast) ok err ->

219+ Decoder $ \ast ok err ->

222 case ast of

220 case ast of

223 Array asts ->

221 Array asts ->

224 listHelp decoder ok err 0 asts []

222 listHelp decoder ok err 0 asts []

225

223

226 _ ->

224 _ ->

227− err (Expecting region TArray)

225+ err (Expecting TArray)

228

226

229

227

230listHelp :: Decoder x a -> ([a] -> b) -> (Problem x -> b) -> Int -> [AST] -> [a] -> b

228listHelp :: Decoder x a -> ([a] -> b) -> (Problem x -> b) -> Int -> [AST] -> [a] -> b

@@ -259,7 +257,7 @@ nonEmptyList decoder x =

259

257

260pair :: Decoder x a -> Decoder x b -> Decoder x (a,b)

258pair :: Decoder x a -> Decoder x b -> Decoder x (a,b)

261pair (Decoder decodeA) (Decoder decodeB) =

259pair (Decoder decodeA) (Decoder decodeB) =

262− Decoder $ \(A.At region ast) ok err ->

260+ Decoder $ \ast ok err ->

263 case ast of

261 case ast of

264 Array vs ->

262 Array vs ->

265 case vs of

263 case vs of

@@ -276,10 +274,10 @@ pair (Decoder decodeA) (Decoder decodeB) =

276 decodeA astA ok0 err0

274 decodeA astA ok0 err0

277

275

278 _ ->

276 _ ->

279− err (Expecting region (TArrayPair (length vs)))

277+ err (Expecting (TArrayPair (length vs)))

280

278

281 _ ->

279 _ ->

282− err (Expecting region TArray)

280+ err (Expecting TArray)

283

281

284

282

285

283

@@ -297,13 +295,13 @@ dict keyDecoder valueDecoder =

297

295

298pairs :: KeyDecoder x k -> Decoder x a -> Decoder x [(k, a)]

296pairs :: KeyDecoder x k -> Decoder x a -> Decoder x [(k, a)]

299pairs keyDecoder valueDecoder =

297pairs keyDecoder valueDecoder =

300− Decoder $ \(A.At region ast) ok err ->

298+ Decoder $ \ast ok err ->

301 case ast of

299 case ast of

302 Object kvs ->

300 Object kvs ->

303 pairsHelp keyDecoder valueDecoder ok err kvs []

301 pairsHelp keyDecoder valueDecoder ok err kvs []

304

302

305 _ ->

303 _ ->

306− err (Expecting region TObject)

304+ err (Expecting TObject)

307

305

308

306

309pairsHelp :: KeyDecoder x k -> Decoder x a -> ([(k, a)] -> b) -> (Problem x -> b) -> [(P.Snippet, AST)] -> [(k, a)] -> b

307pairsHelp :: KeyDecoder x k -> Decoder x a -> ([(k, a)] -> b) -> (Problem x -> b) -> [(P.Snippet, AST)] -> [(k, a)] -> b

@@ -315,7 +313,7 @@ pairsHelp keyDecoder@(KeyDecoder keyParser toBadEnd) valueDecoder@(Decoder decod

315 (snippet, ast) : kvs ->

313 (snippet, ast) : kvs ->

316 case P.fromSnippet keyParser toBadEnd snippet of

314 case P.fromSnippet keyParser toBadEnd snippet of

317 Left x ->

315 Left x ->

318− err (Failure (snippetToRegion snippet) x)

316+ err (Failure x)

319

317

320 Right key ->

318 Right key ->

321 let

319 let

@@ -327,18 +325,13 @@ pairsHelp keyDecoder@(KeyDecoder keyParser toBadEnd) valueDecoder@(Decoder decod

327 decodeA ast ok' err'

325 decodeA ast ok' err'

328

326

329

327

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−

335

328

336-- FIELDS

329-- FIELDS

337

330

338

331

339field :: B.ByteString -> Decoder x a -> Decoder x a

332field :: B.ByteString -> Decoder x a -> Decoder x a

340field key (Decoder decodeA) =

333field key (Decoder decodeA) =

341− Decoder $ \(A.At region ast) ok err ->

334+ Decoder $ \ast ok err ->

342 case ast of

335 case ast of

343 Object kvs ->

336 Object kvs ->

344 case findField key kvs of

337 case findField key kvs of

@@ -350,10 +343,10 @@ field key (Decoder decodeA) =

350 decodeA value ok err'

343 decodeA value ok err'

351

344

352 Nothing ->

345 Nothing ->

353− err (Expecting region (TObjectWith key))

346+ err (Expecting (TObjectWith key))

354

347

355 _ ->

348 _ ->

356− err (Expecting region TObject)

349+ err (Expecting TObject)

357

350

358

351

359findField :: B.ByteString -> [(P.Snippet, AST)] -> Maybe AST

352findField :: B.ByteString -> [(P.Snippet, AST)] -> Maybe AST

@@ -417,8 +410,8 @@ oneOfError problems prob ps =

417

410

418failure :: x -> Decoder x a

411failure :: x -> Decoder x a

419failure x =

412failure x =

420− Decoder $ \(A.At region _) _ err ->

413+ Decoder $ \_ _ err ->

421− err (Failure region x)

414+ err (Failure x)

422

415

423

416

424

417

@@ -437,22 +430,18 @@ mapError func (Decoder decodeA) =

437mapErrorHelp :: (x -> y) -> Problem x -> Problem y

430mapErrorHelp :: (x -> y) -> Problem x -> Problem y

438mapErrorHelp func problem =

431mapErrorHelp func problem =

439 case problem of

432 case problem of

440− Field k p -> Field k (mapErrorHelp func p)

433+ Field k p -> Field k (mapErrorHelp func p)

441− Index i p -> Index i (mapErrorHelp func p)

434+ Index i p -> Index i (mapErrorHelp func p)

442− OneOf p ps -> OneOf (mapErrorHelp func p) (map (mapErrorHelp func) ps)

435+ OneOf p ps -> OneOf (mapErrorHelp func p) (map (mapErrorHelp func) ps)

443− Failure r x -> Failure r (func x)

436+ Failure x -> Failure (func x)

444− Expecting r e -> Expecting r e

437+ Expecting e -> Expecting e

445

438

446

439

447

440

448-- AST

441-- AST

449

442

450

443

451−type AST =

444+data AST

452− A.Located AST_

453−

454−

455−data AST_

456 = Array [AST]

445 = Array [AST]

457 | Object [(P.Snippet, AST)]

446 | Object [(P.Snippet, AST)]

458 | String P.Snippet

447 | String P.Snippet

@@ -471,14 +460,21 @@ type Parser a =

471

460

472

461

473data ParseError

462data ParseError

474− = Start Row Col

463+ = ObjectStart Row Col

475− | ObjectField Row Col

464+ | ObjectMore Row Col

476− | ObjectColon Row Col

477 | ObjectEnd Row Col

465 | ObjectEnd Row Col

466+ | ArrayStart Row Col

467+ | ArrayMore Row Col

478 | ArrayEnd Row Col

468 | ArrayEnd Row Col

469+ | StringStart Row Col

479 | StringProblem StringProblem Row Col

470 | StringProblem StringProblem Row Col

471+ | IntStart Row Col

480 | NoLeadingZeros Row Col

472 | NoLeadingZeros Row Col

481 | NoFloats Row Col

473 | NoFloats Row Col

474+ | Bool Row Col

475+ | Null Row Col

476+ | Value Row Col

477+ | Colon Row Col

482 | BadEnd Row Col

478 | BadEnd Row Col

483

479

484-- PIndex Int ParseError Row Col

480-- PIndex Int ParseError Row Col

@@ -506,15 +502,14 @@ pFile =

506

502

507pValue :: Parser AST

503pValue :: Parser AST

508pValue =

504pValue =

509− P.addLocation $

505+ P.oneOf Value

510− P.oneOf Start

506+ [ String <$> pString

511− [ String <$> pString Start

512 , pObject

507 , pObject

513 , pArray

508 , pArray

514 , pInt

509 , pInt

515− , K.k4 0x74 0x72 0x75 0x65 Start >> return TRUE

510+ , K.k4 0x74 0x72 0x75 0x65 Bool >> return TRUE

516− , K.k5 0x66 0x61 0x6C 0x73 0x65 Start >> return FALSE

511+ , K.k5 0x66 0x61 0x6C 0x73 0x65 Bool >> return FALSE

517− , K.k4 0x6E 0x75 0x6C 0x6C Start >> return NULL

512+ , K.k4 0x6E 0x75 0x6C 0x6C Null >> return NULL

518 ]

513 ]

519

514

520

515

@@ -522,11 +517,11 @@ pValue =

522-- OBJECT

517-- OBJECT

523

518

524

519

525−pObject :: Parser AST_

520+pObject :: Parser AST

526pObject =

521pObject =

527− do P.word1 0x7B {- { -} Start

522+ do P.word1 0x7B {- { -} ObjectStart

528 spaces

523 spaces

529− P.oneOf ObjectField

524+ P.oneOf ObjectMore

530 [ do entry <- pField

525 [ do entry <- pField

531 spaces

526 spaces

532 pObjectHelp [entry]

527 pObjectHelp [entry]

@@ -535,11 +530,11 @@ pObject =

535 ]

530 ]

536

531

537

532

538−pObjectHelp :: [(P.Snippet, AST)] -> Parser AST_

533+pObjectHelp :: [(P.Snippet, AST)] -> Parser AST

539pObjectHelp revEntries =

534pObjectHelp revEntries =

540− P.oneOf ObjectEnd

535+ P.oneOf ObjectMore

541 [

536 [

542− do P.word1 0x2C {-,-} ObjectEnd

537+ do P.word1 0x2C {-,-} ObjectMore

543 spaces

538 spaces

544 entry <- pField

539 entry <- pField

545 spaces

540 spaces

@@ -552,9 +547,9 @@ pObjectHelp revEntries =

552

547

553pField :: Parser (P.Snippet, AST)

548pField :: Parser (P.Snippet, AST)

554pField =

549pField =

555− do key <- pString ObjectField

550+ do key <- pString

556 spaces

551 spaces

557− P.word1 0x3A {-:-} ObjectColon

552+ P.word1 0x3A {-:-} Colon

558 spaces

553 spaces

559 value <- pValue

554 value <- pValue

560 return (key, value)

555 return (key, value)

@@ -564,11 +559,11 @@ pField =

564-- ARRAY

559-- ARRAY

565

560

566

561

567−pArray :: Parser AST_

562+pArray :: Parser AST

568pArray =

563pArray =

569− do P.word1 0x5B {-[-} Start

564+ do P.word1 0x5B {-[-} ArrayStart

570 spaces

565 spaces

571− P.oneOf Start

566+ P.oneOf ArrayMore

572 [ do entry <- pValue

567 [ do entry <- pValue

573 spaces

568 spaces

574 pArrayHelp 1 [entry]

569 pArrayHelp 1 [entry]

@@ -577,11 +572,11 @@ pArray =

577 ]

572 ]

578

573

579

574

580−pArrayHelp :: Int -> [AST] -> Parser AST_

575+pArrayHelp :: Int -> [AST] -> Parser AST

581pArrayHelp !len revEntries =

576pArrayHelp !len revEntries =

582− P.oneOf ArrayEnd

577+ P.oneOf ArrayMore

583 [

578 [

584− do P.word1 0x2C {-,-} ArrayEnd

579+ do P.word1 0x2C {-,-} ArrayMore

585 spaces

580 spaces

586 entry <- pValue

581 entry <- pValue

587 spaces

582 spaces

@@ -596,8 +591,8 @@ pArrayHelp !len revEntries =

596-- STRING

591-- STRING

597

592

598

593

599−pString :: (Row -> Col -> ParseError) -> Parser P.Snippet

594+pString :: Parser P.Snippet

600−pString start =

595+pString =

601 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->

596 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->

602 if pos < end && P.unsafeIndex pos == 0x22 {-"-} then

597 if pos < end && P.unsafeIndex pos == 0x22 {-"-} then

603

598

@@ -622,7 +617,7 @@ pString start =

622 cerr newRow newCol (StringProblem problem)

617 cerr newRow newCol (StringProblem problem)

623

618

624 else

619 else

625− eerr row col start

620+ eerr row col StringStart

626

621

627

622

628data StringStatus

623data StringStatus

@@ -630,7 +625,7 @@ data StringStatus

630 | BadString StringProblem

625 | BadString StringProblem

631

626

632

627

633−pStringHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# StringStatus, Ptr Word8, Row, Col #)

628+pStringHelp :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# StringStatus, Ptr Word8, Word16, Word16 #)

634pStringHelp pos end row col =

629pStringHelp pos end row col =

635 if pos >= end then

630 if pos >= end then

636 (# BadString BadStringEnd, pos, row, col #)

631 (# BadString BadStringEnd, pos, row, col #)

@@ -676,7 +671,7 @@ pStringHelp pos end row col =

676 if word < 0x20 then

671 if word < 0x20 then

677 (# BadString BadStringControlChar, pos, row, col #)

672 (# BadString BadStringControlChar, pos, row, col #)

678 else

673 else

679− let !newPos = plusPtr pos (P.getCharWidth word) in

674+ let !newPos = plusPtr pos (P.getCharWidth pos end word) in

680 pStringHelp newPos end row (col + 1)

675 pStringHelp newPos end row (col + 1)

681

676

682

677

@@ -708,7 +703,7 @@ spaces =

708 cok () newState

703 cok () newState

709

704

710

705

711−eatSpaces :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Ptr Word8, Row, Col #)

706+eatSpaces :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Ptr Word8, Word16, Word16 #)

712eatSpaces pos end row col =

707eatSpaces pos end row col =

713 if pos >= end then

708 if pos >= end then

714 (# pos, row, col #)

709 (# pos, row, col #)

@@ -727,16 +722,16 @@ eatSpaces pos end row col =

727-- INTS

722-- INTS

728

723

729

724

730−pInt :: Parser AST_

725+pInt :: Parser AST

731pInt =

726pInt =

732 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->

727 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->

733 if pos >= end then

728 if pos >= end then

734− eerr row col Start

729+ eerr row col IntStart

735

730

736 else

731 else

737 let !word = P.unsafeIndex pos in

732 let !word = P.unsafeIndex pos in

738 if not (isDecimalDigit word) then

733 if not (isDecimalDigit word) then

739− eerr row col Start

734+ eerr row col IntStart

740

735

741 else if word == 0x30 {-0-} then

736 else if word == 0x30 {-0-} then

742

737

compiler/src/Json/Encode.hs+5−23

@@ -70,6 +70,11 @@ name nm =

70 String (B.char7 '"' <> Name.toBuilder nm <> B.char7 '"')

73+chars :: [Char] -> Value

74+chars chrs =

75+ String (B.char7 '"' <> error "TODO escape this properly. Who is using this?" chrs <> B.char7 '"')

76+

77+

73bool :: Bool -> Value

78bool :: Bool -> Value

74bool =

79bool =

75 Boolean

80 Boolean

@@ -101,29 +106,6 @@ list encodeEntry entries =

101

106

102

107

103

108

104−-- CHARS

105−

106−

107−chars :: [Char] -> Value -- PERF can this be done better? Look for examples.

108−chars chrs =

109− String (B.char7 '"' <> B.stringUtf8 (escape chrs) <> B.char7 '"')

110−

111−

112−escape :: [Char] -> [Char]

113−escape chrs =

114− case chrs of

115− [] ->

116− []

117−

118− c:cs

119− | c == '\r' -> '\\' : 'r' : escape cs

120− | c == '\n' -> '\\' : 'n' : escape cs

121− | c == '\"' -> '\\' : '"' : escape cs

122− | c == '\\' -> '\\' : '\\' : escape cs

123− | otherwise -> c : escape cs

124−

125−

126−

127-- HELPERS

109-- HELPERS

128

110

129

111

compiler/src/Json/String.hs+3−8

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

2{-# LANGUAGE BangPatterns, EmptyDataDecls #-}

3module Json.String

4 ( String

5− , isEmpty

6 --

5 --

7 , fromPtr

6 , fromPtr

8 , fromName

7 , fromName

@@ -37,7 +36,7 @@ import qualified Parse.Primitives as P

39-- INVARIANT: any Json.String is appropriately escaped already

38-- INVARIANT: any Json.String is appropriately escaped already

40−-- PERF: is this the right representation for Json.String? Maybe ByteString instead?

39+-- TODO: is this the right representation for Json.String? Maybe ByteString instead?

41--

40--

42type String =

41type String =

43 Utf8.Utf8 JSON_STRING

42 Utf8.Utf8 JSON_STRING

@@ -46,11 +45,6 @@ type String =

46data JSON_STRING

45data JSON_STRING

49−isEmpty :: String -> Bool

50−isEmpty =

51− Utf8.isEmpty

52−

53−

55-- FROM

49-- FROM

@@ -116,6 +110,7 @@ chompChunks pos end start revChunks =

116 case word of

110 case word of

117 0x0A {-\n-} -> chompEscape 0x6E {-n-} pos end start revChunks

111 0x0A {-\n-} -> chompEscape 0x6E {-n-} pos end start revChunks

118 0x22 {-"-} -> chompEscape 0x22 {-"-} pos end start revChunks

112 0x22 {-"-} -> chompEscape 0x22 {-"-} pos end start revChunks

113+ 0x27 {-'-} -> chompEscape 0x27 {-'-} pos end start revChunks

119 0x5C {-\-} -> chompEscape 0x5C {-\-} pos end start revChunks

114 0x5C {-\-} -> chompEscape 0x5C {-\-} pos end start revChunks

120 0x0D {-\r-} ->

115 0x0D {-\r-} ->

121 let

116 let

@@ -125,7 +120,7 @@ chompChunks pos end start revChunks =

125

120

126 _ ->

121 _ ->

127 let

122 let

128− !width = P.getCharWidth word

123+ !width = P.getCharWidth pos end word

129 !newPos = plusPtr pos width

124 !newPos = plusPtr pos width

130 in

125 in

131 chompChunks newPos end start revChunks

126 chompChunks newPos end start revChunks

compiler/src/Nitpick/PatternMatches.hs+3−3

@@ -22,11 +22,11 @@ import qualified Data.Map as Map

22import qualified Data.Maybe as Maybe

23import qualified Data.Name as Name

24import qualified Data.NonEmptyList as NE

25+import qualified Data.Utf8 as Utf8

26import qualified AST.Canonical as Can

27import qualified AST.Canonical as Can

27import qualified Data.Index as Index

28import qualified Data.Index as Index

28import qualified Elm.ModuleName as ModuleName

29import qualified Elm.ModuleName as ModuleName

29−import qualified Elm.String as ES

30import qualified Reporting.Annotation as A

@@ -41,8 +41,8 @@ data Pattern

43data Literal

44− = Chr ES.String

44+ = Chr Utf8.String

45− | Str ES.String

45+ | Str Utf8.String

46 | Int Int

47 deriving (Eq)

compiler/src/Optimize/DecisionTree.hs+5−5

@@ -27,11 +27,11 @@ import qualified Data.List as List

27import qualified Data.Maybe as Maybe

28import qualified Data.Name as Name

29import qualified Data.Set as Set

30+import qualified Data.Utf8 as Utf8

31import qualified AST.Canonical as Can

32import qualified AST.Canonical as Can

32import qualified Data.Index as Index

33import qualified Data.Index as Index

33import qualified Elm.ModuleName as ModuleName

34import qualified Elm.ModuleName as ModuleName

34−import qualified Elm.String as ES

35import qualified Reporting.Annotation as A

@@ -77,8 +77,8 @@ data Test

77 | IsNil

78 | IsTuple

79 | IsInt Int

80− | IsChr ES.String

80+ | IsChr Utf8.String

81− | IsStr ES.String

81+ | IsStr Utf8.String

82 | IsBool Bool

83 deriving (Eq, Ord)

@@ -618,7 +618,7 @@ instance Binary Test where

618 5 -> liftM IsStr get

619 6 -> liftM IsInt get

620 7 -> liftM IsBool get

621− _ -> fail "problem getting DecisionTree.Test binary"

621+ _ -> error "problem getting DecisionTree.Test binary"

622

623

624instance Binary Path where

@@ -634,4 +634,4 @@ instance Binary Path where

634 0 -> liftM2 Index get get

635 1 -> liftM Unbox get

636 2 -> pure Empty

637− _ -> fail "problem getting DecisionTree.Path binary"

637+ _ -> error "problem getting DecisionTree.Path binary"

compiler/src/Optimize/Module.hs+3−3

@@ -213,10 +213,10 @@ findMain defs =

213 def:rest ->

214 case def of

215 Can.Def (A.At region name) _ _ ->

216− if name == Name._main then Just region else findMain rest

216+ if name == Name.main then Just region else findMain rest

217

218 Can.TypedDef (A.At region name) _ _ _ _ ->

219− if name == Name._main then Just region else findMain rest

219+ if name == Name.main then Just region else findMain rest

220

221

222defToName :: Can.Def -> Name.Name

@@ -244,7 +244,7 @@ addDef home annotations def graph =

244

245addDefHelp :: A.Region -> Annotations -> ModuleName.Canonical -> Name.Name -> [Can.Pattern] -> Can.Expr -> Opt.LocalGraph -> Result i w Opt.LocalGraph

246addDefHelp region annotations home name args body graph@(Opt.LocalGraph _ nodes fieldCounts) =

247− if name /= Name._main then

247+ if name /= Name.main then

248 Result.ok (addDefNode home name args body Set.empty graph)

249 else

250 let

compiler/src/Optimize/Port.hs+3−3

@@ -58,7 +58,7 @@ toEncoder tipe =

58 | name == Name.array -> encodeArray arg

60 _ ->

61− error "toEncoder: bad custom type"

61+ error "toEncoder: bad union type"

63 Can.TRecord _ (Just _) ->

64 error "toEncoder: bad record"

@@ -68,7 +68,7 @@ toEncoder tipe =

68 encodeField (name, Can.FieldType _ fieldType) =

69 do encoder <- toEncoder fieldType

70 let value = Opt.Call encoder [Opt.Access (Opt.VarLocal Name.dollar) name]

71− return $ Opt.Tuple (Opt.Str (Name.toElmString name)) value Nothing

71+ return $ Opt.Tuple (Opt.Str (Name.toUtf8 name)) value Nothing

72 in

73 do object <- encode "object"

74 keyValuePairs <- traverse encodeField (Map.toList fields)

@@ -309,7 +309,7 @@ fieldAndThen decoder (key, Can.FieldType _ tipe) =

309 return $

310 Opt.Call andThen

311 [ Opt.Function [key] decoder

312− , Opt.Call field [ Opt.Str (Name.toElmString key), typeDecoder ]

312+ , Opt.Call field [ Opt.Str (Name.toUtf8 key), typeDecoder ]

313 ]

314

315

compiler/src/Parse/Docs.hsnew file+275

@@ -0,0 +1,275 @@

1+module Parse.Docs

2+ ( Docs(..)

3+ , parser

4+ )

5+ where

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+32−40

@@ -128,46 +128,38 @@ chompListEnd start entries =

128tuple :: A.Position -> Parser E.Expr Src.Expr

129tuple start@(A.Position row col) =

130 inContext E.Tuple (word1 0x28 {-(-} E.Start) $

131− do before <- getPosition

131+ oneOf E.TupleIndentExpr1

132− Space.chompAndCheckIndent E.TupleSpace E.TupleIndentExpr1

132+ [

133− after <- getPosition

133+ do op <- Symbol.operator E.TupleIndentExpr1 E.TupleOperatorReserved

134− if before /= after

134+ if op == "-"

135− then

135+ then

136− do (entry, end) <- specialize E.TupleExpr expression

136+ oneOf E.TupleOperatorClose

137− Space.checkIndent end E.TupleIndentEnd

137+ [

138− chompTupleEnd start entry []

138+ do word1 0x29 {-)-} E.TupleOperatorClose

139− else

139+ addEnd start (Src.Op op)

140− oneOf E.TupleIndentExpr1

140+ ,

141− [

141+ do (entry, end) <-

142− do op <- Symbol.operator E.TupleIndentExpr1 E.TupleOperatorReserved

142+ specialize E.TupleExpr $

143− if op == "-"

143+ do negatedExpr@(A.At (A.Region _ end) _) <- term

144− then

144+ Space.chomp E.Space

145− oneOf E.TupleOperatorClose

145+ let exprStart = A.Position row (col + 2)

146− [

146+ let expr = A.at exprStart end (Src.Negate negatedExpr)

147− do word1 0x29 {-)-} E.TupleOperatorClose

147+ chompExprEnd exprStart (State [] expr [] end)

148− addEnd start (Src.Op op)

148+ Space.checkIndent end E.TupleIndentEnd

149− ,

149+ chompTupleEnd start entry []

150− do (entry, end) <-

150+ ]

151− specialize E.TupleExpr $

151+ else

152− do negatedExpr@(A.At (A.Region _ end) _) <- term

152+ do word1 0x29 {-)-} E.TupleOperatorClose

153− Space.chomp E.Space

153+ addEnd start (Src.Op op)

154− let exprStart = A.Position row (col + 2)

154+ ,

155− let expr = A.at exprStart end (Src.Negate negatedExpr)

155+ do word1 0x29 {-)-} E.TupleIndentExpr1

156− chompExprEnd exprStart (State [] expr [] end)

156+ addEnd start Src.Unit

157− Space.checkIndent end E.TupleIndentEnd

157+ ,

158− chompTupleEnd start entry []

158+ do Space.chompAndCheckIndent E.TupleSpace E.TupleIndentExpr1

159− ]

159+ (entry, end) <- specialize E.TupleExpr expression

160− else

160+ Space.checkIndent end E.TupleIndentEnd

161− do word1 0x29 {-)-} E.TupleOperatorClose

161+ chompTupleEnd start entry []

162− addEnd start (Src.Op op)

162+ ]

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

171

163

172

164

173chompTupleEnd :: A.Position -> Src.Expr -> [Src.Expr] -> Parser E.Tuple Src.Expr

165chompTupleEnd :: A.Position -> Src.Expr -> [Src.Expr] -> Parser E.Tuple Src.Expr

compiler/src/Parse/Module.hs+60−110

@@ -2,10 +2,7 @@

2{-# LANGUAGE OverloadedStrings #-}

3module Parse.Module

4 ( fromByteString

5− , ProjectType(..)

6− , isKernel

7 , chompImports

5 , chompImports

8− , chompImport

9 )

6 )

10 where

7 where

@@ -31,37 +28,14 @@ import qualified Reporting.Error.Syntax as E

31-- FROM BYTE STRING

28-- FROM BYTE STRING

34−fromByteString :: ProjectType -> BS.ByteString -> Either E.Error Src.Module

31+fromByteString :: Pkg.Name -> BS.ByteString -> Either E.Error Src.Module

35−fromByteString projectType source =

32+fromByteString pkg source =

36− case P.fromByteString (chompModule projectType) E.ModuleBadEnd source of

33+ case P.fromByteString (chompModule pkg) E.ModuleBadEnd source of

37− Right modul -> checkModule projectType modul

34+ Right modul -> checkModule modul

38 Left err -> Left (E.ParseError err)

35 Left err -> Left (E.ParseError err)

42−-- PROJECT TYPE

43−

44−

45−data ProjectType

46− = Package Pkg.Name

47− | Application

48−

49−

50−isCore :: ProjectType -> Bool

51−isCore projectType =

52− case projectType of

53− Package pkg -> pkg == Pkg.core

54− Application -> False

55−

56−

57−isKernel :: ProjectType -> Bool

58−isKernel projectType =

59− case projectType of

60− Package pkg -> Pkg.isKernel pkg

61− Application -> False

62−

63−

64−

65-- MODULE

39-- MODULE

@@ -74,11 +48,11 @@ data Module =

74 }

48 }

77−chompModule :: ProjectType -> Parser E.Module Module

51+chompModule :: Pkg.Name -> Parser E.Module Module

78−chompModule projectType =

52+chompModule pkg =

79 do header <- chompHeader

53 do header <- chompHeader

80− imports <- chompImports (if isCore projectType then [] else Imports.defaults)

54+ imports <- chompImports (if pkg == Pkg.core then [] else Imports.defaults)

81− infixes <- if isKernel projectType then chompInfixes [] else return []

55+ infixes <- if Pkg.isKernel pkg then chompInfixes [] else return []

82 decls <- specialize E.Declarations $ chompDecls []

56 decls <- specialize E.Declarations $ chompDecls []

83 return (Module header imports infixes decls)

57 return (Module header imports infixes decls)

@@ -87,15 +61,15 @@ chompModule projectType =

87-- CHECK MODULE

61-- CHECK MODULE

90−checkModule :: ProjectType -> Module -> Either E.Error Src.Module

64+checkModule :: Module -> Either E.Error Src.Module

91−checkModule projectType (Module maybeHeader imports infixes decls) =

65+checkModule (Module maybeHeader imports infixes decls) =

92 let

66 let

93 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls

67 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls

94 in

68 in

95 case maybeHeader of

69 case maybeHeader of

96 Just (Header name effects exports docs) ->

70 Just (Header name effects exports docs) ->

97 Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes

71 Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes

98− <$> checkEffects projectType ports effects

72+ <$> checkEffects ports effects

100 Nothing ->

74 Nothing ->

101 Right $

75 Right $

@@ -105,37 +79,23 @@ checkModule projectType (Module maybeHeader imports infixes decls) =

105 _:_ -> Src.Ports ports

79 _:_ -> Src.Ports ports

106

107

108−checkEffects :: ProjectType -> [Src.Port] -> Effects -> Either E.Error Src.Effects

82+checkEffects :: [Src.Port] -> Effects -> Either E.Error Src.Effects

109−checkEffects projectType ports effects =

83+checkEffects ports effects =

110 case effects of

84 case effects of

111 NoEffects region ->

85 NoEffects region ->

112 case ports of

86 case ports of

113− [] ->

87+ [] -> Right Src.NoEffects

114− Right Src.NoEffects

88+ _:_ -> Left (E.UnexpectedPort region)

115−

116− Src.Port name _ : _ ->

117− case projectType of

118− Package _ -> Left (E.NoPortsInPackage name)

119− Application -> Left (E.UnexpectedPort region)

120

121 Ports region ->

90 Ports region ->

122− case projectType of

91+ case ports of

123− Package _ ->

92+ [] -> Left (E.NoPorts region)

124− Left (E.NoPortModulesInPackage region)

93+ _:_ -> Right (Src.Ports ports)

125−

126− Application ->

127− case ports of

128− [] -> Left (E.NoPorts region)

129− _:_ -> Right (Src.Ports ports)

130

131 Manager region manager ->

95 Manager region manager ->

132− if isKernel projectType then

96+ case ports of

133− case ports of

97+ [] -> Right (Src.Manager region manager)

134− [] -> Right (Src.Manager region manager)

98+ _:_ -> Left (E.UnexpectedPort region)

135− _:_ -> Left (E.UnexpectedPort region)

136− else

137− Left (E.NoEffectsOutsideKernel region)

138−

139

140

100

141categorizeDecls :: [A.Located Src.Value] -> [A.Located Src.Union] -> [A.Located Src.Alias] -> [Src.Port] -> [Decl.Decl] -> ( [A.Located Src.Value], [A.Located Src.Union], [A.Located Src.Alias], [Src.Port] )

101categorizeDecls :: [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] )

@@ -372,33 +332,28 @@ spaces_em =

372

332

373

333

374chompImports :: [Src.Import] -> Parser E.Module [Src.Import]

334chompImports :: [Src.Import] -> Parser E.Module [Src.Import]

375−chompImports is =

335+chompImports imports =

376 oneOfWithFallback

336 oneOfWithFallback

377− [ do i <- chompImport

337+ [ do Keyword.import_ E.ImportStart

378− chompImports (i:is)

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

379 ]

351 ]

380− (reverse is)

352+ (reverse imports)

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

398

353

399

354

400−chompAs :: A.Located Name.Name -> Parser E.Module Src.Import

355+chompAs :: A.Located Name.Name -> [Src.Import] -> Parser E.Module [Src.Import]

401−chompAs name =

356+chompAs name imports =

402 do Keyword.as_ E.ImportAs

357 do Keyword.as_ E.ImportAs

403 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias

358 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias

404 alias <- Var.upper E.ImportAlias

359 alias <- Var.upper E.ImportAlias

@@ -406,19 +361,21 @@ chompAs name =

406 Space.chomp E.ModuleSpace

361 Space.chomp E.ModuleSpace

407 oneOf E.ImportEnd

362 oneOf E.ImportEnd

408 [ do Space.checkFreshLine E.ImportEnd

363 [ do Space.checkFreshLine E.ImportEnd

409− return $ Src.Import name (Just alias) (Src.Explicit [])

364+ chompImports $

365+ Src.Import name (Just alias) (Src.Explicit []) : imports

410 , do Space.checkIndent end E.ImportEnd

366 , do Space.checkIndent end E.ImportEnd

411− chompExposing name (Just alias)

367+ chompExposing name (Just alias) imports

412 ]

368 ]

413

369

414

370

415−chompExposing :: A.Located Name.Name -> Maybe Name.Name -> Parser E.Module Src.Import

371+chompExposing :: A.Located Name.Name -> Maybe Name.Name -> [Src.Import] -> Parser E.Module [Src.Import]

416−chompExposing name maybeAlias =

372+chompExposing name maybeAlias imports =

417 do Keyword.exposing_ E.ImportExposing

373 do Keyword.exposing_ E.ImportExposing

418 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentExposingList

374 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentExposingList

419 exposed <- specialize E.ImportExposingList exposing

375 exposed <- specialize E.ImportExposingList exposing

420 freshLine E.ImportEnd

376 freshLine E.ImportEnd

421− return $ Src.Import name maybeAlias exposed

377+ chompImports $

378+ Src.Import name maybeAlias exposed : imports

422

379

423

380

424

381

@@ -434,18 +391,18 @@ exposing =

434 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

391 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

435 word1 0x29 {-)-} E.ExposingEnd

392 word1 0x29 {-)-} E.ExposingEnd

436 return Src.Open

393 return Src.Open

437− , do exposed <- chompExposed

394+ , do exposed <- addLocation chompExposed

438 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

395 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

439 exposingHelp [exposed]

396 exposingHelp [exposed]

440 ]

397 ]

441

398

442

399

443−exposingHelp :: [Src.Exposed] -> Parser E.Exposing Src.Exposing

400+exposingHelp :: [A.Located Src.Exposed] -> Parser E.Exposing Src.Exposing

444exposingHelp revExposed =

401exposingHelp revExposed =

445 oneOf E.ExposingEnd

402 oneOf E.ExposingEnd

446 [ do word1 0x2C {-,-} E.ExposingEnd

403 [ do word1 0x2C {-,-} E.ExposingEnd

447 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue

404 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue

448− exposed <- chompExposed

405+ exposed <- addLocation chompExposed

449 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

406 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

450 exposingHelp (exposed:revExposed)

407 exposingHelp (exposed:revExposed)

451 , do word1 0x29 {-)-} E.ExposingEnd

408 , do word1 0x29 {-)-} E.ExposingEnd

@@ -455,21 +412,16 @@ exposingHelp revExposed =

455

412

456chompExposed :: Parser E.Exposing Src.Exposed

413chompExposed :: Parser E.Exposing Src.Exposed

457chompExposed =

414chompExposed =

458− do start <- getPosition

415+ oneOf E.ExposingValue

459− oneOf E.ExposingValue

416+ [ Src.Lower <$> Var.lower E.ExposingValue

460− [ do name <- Var.lower E.ExposingValue

417+ , do word1 0x28 {-(-} E.ExposingValue

461− end <- getPosition

418+ op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved

462− return $ Src.Lower $ A.at start end name

419+ word1 0x29 {-)-} E.ExposingOperatorRightParen

463− , do word1 0x28 {-(-} E.ExposingValue

420+ return (Src.Operator op)

464− op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved

421+ , do name <- Var.upper E.ExposingValue

465− word1 0x29 {-)-} E.ExposingOperatorRightParen

422+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

466− end <- getPosition

423+ Src.Upper name <$> privacy

467− return $ Src.Operator (A.Region start end) op

424+ ]

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

473

425

474

426

475privacy :: Parser E.Exposing Src.Privacy

427privacy :: Parser E.Exposing Src.Privacy

@@ -477,11 +429,9 @@ privacy =

477 oneOfWithFallback

429 oneOfWithFallback

478 [ do word1 0x28 {-(-} E.ExposingTypePrivacy

430 [ do word1 0x28 {-(-} E.ExposingTypePrivacy

479 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy

431 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy

480− start <- getPosition

481 word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy

432 word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy

482− end <- getPosition

483 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy

433 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy

484 word1 0x29 {-)-} E.ExposingTypePrivacy

434 word1 0x29 {-)-} E.ExposingTypePrivacy

485− return $ Src.Public (A.Region start end)

435+ return Src.Public

486 ]

436 ]

487 Src.Private

437 Src.Private

compiler/src/Parse/Pattern.hs+1−1

@@ -129,7 +129,7 @@ recordHelp start vars =

129 Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd

130 recordHelp start (var:vars)

131 , do word1 0x7D {-}-} E.PRecordEnd

132− addEnd start (Src.PRecord (reverse vars))

132+ addEnd start (Src.PRecord vars)

133 ]

134

135

compiler/src/Parse/Primitives.hs+4−4

@@ -46,7 +46,7 @@ newtype Parser x a =

46 )

49−data State = -- PERF try taking some out to avoid allocation

49+data State = -- TODO try taking some out to avoid allocation?

50 State

51 { _src :: ForeignPtr Word8

52 , _pos :: !(Ptr Word8)

@@ -145,7 +145,7 @@ oneOfHelp state cok eok cerr eerr toError parsers =

145

146

147{-# INLINE oneOfWithFallback #-}

148−oneOfWithFallback :: [Parser x a] -> a -> Parser x a -- PERF is this function okay? Worried about allocation/laziness with fallback values.

148+oneOfWithFallback :: [Parser x a] -> a -> Parser x a -- TODO is this function okay? Worried about allocation/laziness with fallback values.

149oneOfWithFallback parsers fallback =

150 Parser $ \state cok eok cerr _ ->

151 oowfHelp state cok eok cerr parsers fallback

@@ -394,8 +394,8 @@ isWord pos end word =

394 pos < end && unsafeIndex pos == word

395

396

397−getCharWidth :: Word8 -> Int

397+getCharWidth :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int

398−getCharWidth word

398+getCharWidth _pos _end word -- TODO remove unused variables. Shorter stack?

399 | word < 0x80 = 1

400 | word < 0xc0 = error "Need UTF-8 encoded input. Ran into unrecognized bits."

401 | word < 0xe0 = 2

compiler/src/Parse/Repl.hsnew file+117

@@ -0,0 +1,117 @@

1+{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+module Parse.Repl

4+ ( Entry(..)

5+ , parseEntry

6+ )

7+ where

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/Shader.hs+1−1

@@ -96,7 +96,7 @@ eatShader pos end row col =

96 eatShader (plusPtr pos 1) end (row + 1) 1

98 else

99− let !newPos = plusPtr pos (P.getCharWidth word) in

99+ let !newPos = plusPtr pos (P.getCharWidth pos end word) in

100 eatShader newPos end row (col + 1)

101

102

compiler/src/Parse/Space.hs+4−4

@@ -157,7 +157,7 @@ eatSpaces pos end row col =

157-- LINE COMMENTS

158

159

160−eatLineComment :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Status, Ptr Word8, Row, Col #)

160+eatLineComment :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Status, Ptr Word8, Word16, Word16 #)

161eatLineComment pos end row col =

162 if pos >= end then

163 (# Good, pos, row, col #)

@@ -167,7 +167,7 @@ eatLineComment pos end row col =

167 if word == 0x0A {- \n -} then

168 eatSpaces (plusPtr pos 1) end (row + 1) 1

169 else

170− let !newPos = plusPtr pos (P.getCharWidth word) in

170+ let !newPos = plusPtr pos (P.getCharWidth pos end word) in

171 eatLineComment newPos end row (col + 1)

172

173

@@ -208,7 +208,7 @@ data MultiStatus

208 | MultiEndless

209

210

211−eatMultiCommentHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> (# MultiStatus, Ptr Word8, Row, Col #)

211+eatMultiCommentHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> (# MultiStatus, Ptr Word8, Word16, Word16 #)

212eatMultiCommentHelp pos end row col openComments =

213 if pos >= end then

214 (# MultiEndless, pos, row, col #)

@@ -231,7 +231,7 @@ eatMultiCommentHelp pos end row col openComments =

231 eatMultiCommentHelp (plusPtr pos 2) end row (col + 2) (openComments + 1)

232

233 else

234− let !newPos = plusPtr pos (P.getCharWidth word) in

234+ let !newPos = plusPtr pos (P.getCharWidth pos end word) in

235 eatMultiCommentHelp newPos end row (col + 1) openComments

236

237

compiler/src/Parse/String.hs+5−5

@@ -87,7 +87,7 @@ chompChar pos end row col numChars mostRecent =

88 else

89 let

90− !width = P.getCharWidth word

90+ !width = P.getCharWidth pos end word

91 !newPos = plusPtr pos width

92 in

93 chompChar newPos end row (col + 1) (numChars + 1) (ES.Slice pos width)

@@ -165,7 +165,7 @@ addEscape chunk start end revChunks =

165-- SINGLE STRINGS

166

167

168−singleString :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> [ES.Chunk] -> StringResult

168+singleString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [ES.Chunk] -> StringResult

169singleString pos end row col initialPos revChunks =

170 if pos >= end then

171 Err row col E.StringEndless_Single

@@ -203,7 +203,7 @@ singleString pos end row col initialPos revChunks =

203 Err row (col + 1) E.StringEndless_Single

204

205 else

206− let !newPos = plusPtr pos (P.getCharWidth word) in

206+ let !newPos = plusPtr pos (P.getCharWidth pos end word) in

207 singleString newPos end row (col + 1) initialPos revChunks

208

209

@@ -211,7 +211,7 @@ singleString pos end row col initialPos revChunks =

211-- MULTI STRINGS

212

213

214−multiString :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> Row -> Col -> [ES.Chunk] -> StringResult

214+multiString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> Word16 -> Word16 -> [ES.Chunk] -> StringResult

215multiString pos end row col initialPos sr sc revChunks =

216 if pos >= end then

217 Err sr sc E.StringEndless_Multi

@@ -254,7 +254,7 @@ multiString pos end row col initialPos sr sc revChunks =

254 Err sr sc E.StringEndless_Multi

255

256 else

257− let !newPos = plusPtr pos (P.getCharWidth word) in

257+ let !newPos = plusPtr pos (P.getCharWidth pos end word) in

258 multiString newPos end row (col + 1) initialPos sr sc revChunks

259

260

compiler/src/Parse/Symbol.hs+1−1

@@ -40,7 +40,7 @@ operator toExpectation toError =

41 else

42 case Name.fromPtr pos newPos of

43− "." -> eerr row col (toError BadDot)

43+ "." -> cerr row col (toError BadDot)

44 "|" -> cerr row col (toError BadPipe)

45 "->" -> cerr row col (toError BadArrow)

46 "=" -> cerr row col (toError BadEquals)

compiler/src/Parse/Variable.hs+3−3

@@ -67,7 +67,7 @@ lower toError =

69{-# NOINLINE reservedWords #-}

70−reservedWords :: Set.Set Name.Name -- PERF try using a trie instead

70+reservedWords :: Set.Set Name.Name -- TODO try using a trie instead

71reservedWords =

72 Set.fromList

73 [ "if", "then", "else"

@@ -149,14 +149,14 @@ foreignUpper toError =

149 let

150 !newState = P.State src upperEnd end indent row newCol

151 !name = Name.fromPtr upperStart upperEnd

152− !upperName =

152+ !foreign =

153 if upperStart == pos then

154 Unqualified name

155 else

156 let !home = Name.fromPtr pos (plusPtr upperStart (-1)) in

157 Qualified home name

158 in

159− cok upperName newState

159+ cok foreign newState

160

161

162foreignUpperHelp :: 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)

28data Located a =

29− At Region a -- PERF see if unpacking region is helpful

29+ At Region a -- TODO see if unpacking region is helpful

32instance Functor Located where

compiler/src/Reporting/Doc.hs+47−79

@@ -7,38 +7,16 @@ module Reporting.Doc

7 , P.hcat, P.hsep, P.indent, P.sep, P.vcat

8 , P.red, P.cyan, P.magenta, P.green, P.blue, P.black, P.yellow

9 , P.dullred, P.dullcyan, P.dullyellow

10− --

10+

11− , fromChars

11+ , fromChars, fromName, fromInt, fromUtf8

12− , fromName

12+ , toAnsi, toString, toLine

13− , fromVersion

14− , fromPackage

15− , fromInt

16− --

17− , toAnsi

18− , toString

19− , toLine

20− --

21 , encode

13 , encode

22− --

14+

23− , stack

15+ , stack, reflow, commaSep

24− , reflow

16+ , toSimpleNote, toSimpleHint, toFancyHint

25− , commaSep

17+ , link, fancyLink, reflowLink, makeLink, makeNakedLink

26− --

18+ , args, moreArgs

27− , toSimpleNote

19+ , ordinal, intToOrdinal

28− , toFancyNote

29− , toSimpleHint

30− , toFancyHint

31− --

32− , link

33− , fancyLink

34− , reflowLink

35− , makeLink

36− , makeNakedLink

37− --

38− , args

39− , moreArgs

40− , ordinal

41− , intToOrdinal

42 , cycle

20 , cycle

43 )

21 )

44 where

22 where

@@ -48,17 +26,14 @@ import Prelude hiding (cycle)

48import qualified Data.List as List

26import qualified Data.List as List

49import Data.Monoid ((<>))

27import Data.Monoid ((<>))

50import qualified Data.Name as Name

28import qualified Data.Name as Name

29+import qualified Data.Utf8 as Utf8

51import qualified System.Console.ANSI.Types as Ansi

30import qualified System.Console.ANSI.Types as Ansi

52import qualified System.Info as Info

31import qualified System.Info as Info

53import System.IO (Handle)

32import System.IO (Handle)

54import qualified Text.PrettyPrint.ANSI.Leijen as P

33import qualified Text.PrettyPrint.ANSI.Leijen as P

56import qualified Data.Index as Index

35import qualified Data.Index as Index

57−import qualified Elm.Package as Pkg

58−import qualified Elm.Version as V

59−import Json.Encode ((==>))

60import qualified Json.Encode as E

36import qualified Json.Encode as E

61−import qualified Json.String as Json

@@ -75,21 +50,16 @@ fromName name =

75 P.text (Name.toChars name)

50 P.text (Name.toChars name)

78−fromVersion :: V.Version -> P.Doc

79−fromVersion vsn =

80− P.text (V.toChars vsn)

81−

82−

83−fromPackage :: Pkg.Name -> P.Doc

84−fromPackage pkg =

85− P.text (Pkg.toChars pkg)

86−

87−

88fromInt :: Int -> P.Doc

53fromInt :: Int -> P.Doc

89fromInt n =

54fromInt n =

90 P.text (show n)

55 P.text (show n)

58+fromUtf8 :: Utf8.String -> P.Doc

59+fromUtf8 utf8 =

60+ P.text (Utf8.toChars utf8)

61+

62+

94-- TO STRING

64-- TO STRING

@@ -141,21 +111,12 @@ commaSep conjunction addStyle names =

141

111

142

112

143

113

144−-- NOTES

114+-- HINTS

145

115

146

116

147toSimpleNote :: String -> P.Doc

117toSimpleNote :: String -> P.Doc

148toSimpleNote message =

118toSimpleNote message =

149− toFancyNote (map P.text (words message))

119+ P.fillSep ((P.underline "Note" <> ":") : map P.text (words message))

150−

151−

152−toFancyNote :: [P.Doc] -> P.Doc

153−toFancyNote chunks =

154− P.fillSep (P.underline "Note" <> ":" : chunks)

155−

156−

157−

158−-- HINTS

159

120

160

121

161toSimpleHint :: String -> P.Doc

122toSimpleHint :: String -> P.Doc

@@ -172,32 +133,32 @@ toFancyHint chunks =

172-- LINKS

133-- LINKS

173

134

174

135

175−link :: String -> String -> String -> String -> P.Doc

136+link :: P.Doc -> String -> String -> String -> P.Doc

176link word before fileName after =

137link word before fileName after =

177 P.fillSep $

138 P.fillSep $

178− (P.underline (P.text word) <> ":")

139+ (P.underline word <> ":")

179 : map P.text (words before)

140 : map P.text (words before)

180 ++ P.text (makeLink fileName)

141 ++ P.text (makeLink fileName)

181 : map P.text (words after)

142 : map P.text (words after)

182

143

183

144

184−fancyLink :: String -> [P.Doc] -> String -> [P.Doc] -> P.Doc

145+fancyLink :: P.Doc -> [P.Doc] -> String -> [P.Doc] -> P.Doc

185fancyLink word before fileName after =

146fancyLink word before fileName after =

186 P.fillSep $

147 P.fillSep $

187− (P.underline (P.text word) <> ":") : before ++ P.text (makeLink fileName) : after

148+ (P.underline word <> ":") : before ++ P.text (makeLink fileName) : after

188

149

189

150

190−makeLink :: [Char] -> [Char]

151+makeLink :: String -> String

191makeLink fileName =

152makeLink fileName =

192− "<https://elm-lang.org/" <> V.toChars V.compiler <> "/" <> fileName <> ">"

153+ "<https://elm-lang.org/" <> error "TODO V.toString V.compiler" <> "/" <> fileName <> ">"

193

154

194

155

195−makeNakedLink :: [Char] -> [Char]

156+makeNakedLink :: String -> String

196makeNakedLink fileName =

157makeNakedLink fileName =

197− "https://elm-lang.org/" <> V.toChars V.compiler <> "/" <> fileName

158+ "https://elm-lang.org/" <> error "TODO V.toString V.compiler" <> "/" <> fileName

198

159

199

160

200−reflowLink :: [Char] -> [Char] -> [Char] -> P.Doc

161+reflowLink :: String -> String -> String -> P.Doc

201reflowLink before fileName after =

162reflowLink before fileName after =

202 P.fillSep $

163 P.fillSep $

203 map P.text (words before)

164 map P.text (words before)

@@ -306,8 +267,10 @@ data Color

306 | WHITE

267 | WHITE

307

268

308

269

309−toJsonHelp :: Style -> [String] -> P.SimpleDoc -> [E.Value]

270+toJsonHelp :: Style -> [a] -> P.SimpleDoc -> [E.Value]

310toJsonHelp style revChunks simpleDoc =

271toJsonHelp style revChunks simpleDoc =

272+ error "TODO generate json on errors" style revChunks simpleDoc sgrToStyle encodeColor

273+{-

311 case simpleDoc of

274 case simpleDoc of

312 P.SFail ->

275 P.SFail ->

313 error $

276 error $

@@ -318,18 +281,23 @@ toJsonHelp style revChunks simpleDoc =

318 [ encodeChunks style revChunks ]

281 [ encodeChunks style revChunks ]

319

282

320 P.SChar char rest ->

283 P.SChar char rest ->

321− toJsonHelp style ([char] : revChunks) rest

284+ toJsonHelp style (TB.singleton char : revChunks) rest

322

285

323 P.SText _ string rest ->

286 P.SText _ string rest ->

324− toJsonHelp style (string : revChunks) rest

287+ toJsonHelp style (TB.fromString string : revChunks) rest

325

288

326 P.SLine indent rest ->

289 P.SLine indent rest ->

327− toJsonHelp style (replicate indent ' ' : "\n" : revChunks) rest

290+ toJsonHelp style (spaces indent : "\n" : revChunks) rest

328

291

329 P.SSGR sgrs rest ->

292 P.SSGR sgrs rest ->

330 encodeChunks style revChunks : toJsonHelp (sgrToStyle sgrs style) [] rest

293 encodeChunks style revChunks : toJsonHelp (sgrToStyle sgrs style) [] rest

331

294

332

295

296+spaces :: Int -> TB.Builder

297+spaces n =

298+ TB.fromText (Text.replicate n " ")

299+-}

300+

333sgrToStyle :: [Ansi.SGR] -> Style -> Style

301sgrToStyle :: [Ansi.SGR] -> Style -> Style

334sgrToStyle sgrs style@(Style bold underline color) =

302sgrToStyle sgrs style@(Style bold underline color) =

335 case sgrs of

303 case sgrs of

@@ -390,28 +358,28 @@ toColor layer intensity color =

390 Ansi.White -> pick White WHITE

358 Ansi.White -> pick White WHITE

391 Ansi.Black -> pick Black BLACK

359 Ansi.Black -> pick Black BLACK

392

360

393−

361+{-

394−encodeChunks :: Style -> [String] -> E.Value

362+encodeChunks :: Style -> [TB.Builder] -> E.Value

395encodeChunks (Style bold underline color) revChunks =

363encodeChunks (Style bold underline color) revChunks =

396 let

364 let

397− chars = concat (reverse revChunks)

365+ !str = Utf8.concat (reverse revChunks)

398 in

366 in

399 case color of

367 case color of

400 Nothing | not bold && not underline ->

368 Nothing | not bold && not underline ->

401− E.chars chars

369+ E.string str

402

370

403 _ ->

371 _ ->

404 E.object

372 E.object

405− [ "bold" ==> E.bool bold

373+ [ ("bold", E.bool bold)

406− , "underline" ==> E.bool underline

374+ , ("underline", E.bool underline)

407− , "color" ==> maybe E.null encodeColor color

375+ , ("color", maybe E.null encodeColor color)

408− , "string" ==> E.chars chars

376+ , ("string", E.string str)

409 ]

377 ]

410−

378+-}

411

379

412encodeColor :: Color -> E.Value

380encodeColor :: Color -> E.Value

413encodeColor color =

381encodeColor color =

414− E.string $ Json.fromChars $

382+ E.string $

415 case color of

383 case color of

416 Red -> "red"

384 Red -> "red"

417 RED -> "RED"

385 RED -> "RED"

compiler/src/Reporting/Error.hs+26−32

@@ -10,9 +10,10 @@ module Reporting.Error

12import qualified Data.ByteString as B

13+import qualified Data.Name as Name

13import qualified Data.NonEmptyList as NE

14import qualified Data.NonEmptyList as NE

14import qualified Data.OneOrMore as OneOrMore

15import qualified Data.OneOrMore as OneOrMore

15−import qualified System.FilePath as FP

16+import qualified Data.Utf8 as Utf8

17import qualified Elm.ModuleName as ModuleName

18import qualified Elm.ModuleName as ModuleName

18import qualified File

19import qualified File

@@ -21,7 +22,6 @@ import Json.Encode ((==>))

21import qualified Reporting.Annotation as A

22import qualified Reporting.Annotation as A

22import qualified Reporting.Doc as D

23import qualified Reporting.Doc as D

23import qualified Reporting.Error.Canonicalize as Canonicalize

24import qualified Reporting.Error.Canonicalize as Canonicalize

24−import qualified Reporting.Error.Docs as Docs

25import qualified Reporting.Error.Import as Import

26import qualified Reporting.Error.Main as Main

27import qualified Reporting.Error.Pattern as Pattern

@@ -39,8 +39,8 @@ import qualified Reporting.Report as Report

39data Module =

40 Module

41 { _name :: ModuleName.Raw

42− , _absolutePath :: FilePath

42+ , _path :: FilePath

43− , _modificationTime :: File.Time

43+ , _time :: File.Time

44 , _source :: B.ByteString

45 , _error :: Error

46 }

@@ -57,7 +57,6 @@ data Error

57 | BadTypes L.Localizer (NE.List Type.Error)

58 | BadMains L.Localizer (OneOrMore.OneOrMore Main.Error)

59 | BadPatterns (NE.List Pattern.Error)

60− | BadDocs Docs.Error

@@ -85,34 +84,32 @@ toReports source err =

85 BadPatterns errs ->

84 BadPatterns errs ->

86 fmap (Pattern.toReport source) errs

85 fmap (Pattern.toReport source) errs

88− BadDocs docsErr ->

89− Docs.toReports source docsErr

90−

93-- TO DOC

89-- TO DOC

96−toDoc :: FilePath -> Module -> [Module] -> D.Doc

92+toDoc :: Module -> [Module] -> D.Doc

97−toDoc root err errs =

93+toDoc err errs =

98 let

94 let

99− (NE.List m ms) = NE.sortBy _modificationTime (NE.List err errs)

95+ timeCompare m1 m2 = compare (_time m1) (_time m2)

96+ (NE.List m ms) = NE.sortBy timeCompare (NE.List err errs)

100 in

97 in

101− D.vcat (toDocHelp root m ms)

98+ D.vcat (toDocHelp m ms)

102

103

100

104−toDocHelp :: FilePath -> Module -> [Module] -> [D.Doc]

101+toDocHelp :: Module -> [Module] -> [D.Doc]

105−toDocHelp root module1 modules =

102+toDocHelp module1 modules =

106 case modules of

103 case modules of

107 [] ->

104 [] ->

108− [moduleToDoc root module1

105+ [moduleToDoc module1

109 ,""

106 ,""

110 ]

107 ]

111

108

112 module2 : otherModules ->

109 module2 : otherModules ->

113− moduleToDoc root module1

110+ moduleToDoc module1

114 : toSeparator module1 module2

111 : toSeparator module1 module2

115− : toDocHelp root module2 otherModules

112+ : toDocHelp module2 otherModules

116

113

117

114

118toSeparator :: Module -> Module -> D.Doc

115toSeparator :: Module -> Module -> D.Doc

@@ -134,22 +131,19 @@ toSeparator beforeModule afterModule =

134-- MODULE TO DOC

131-- MODULE TO DOC

135

132

136

133

137−moduleToDoc :: FilePath -> Module -> D.Doc

134+moduleToDoc :: Module -> D.Doc

138−moduleToDoc root (Module _ absolutePath _ source err) =

135+moduleToDoc (Module _ path _ source err) =

139 let

136 let

140 reports =

137 reports =

141 toReports (Code.toSource source) err

138 toReports (Code.toSource source) err

142−

143− relativePath =

144− FP.makeRelative root absolutePath

145 in

139 in

146− D.vcat $ map (reportToDoc relativePath) (NE.toList reports)

140+ D.vcat $ map (reportToDoc path) (NE.toList reports)

147

141

148

142

149reportToDoc :: FilePath -> Report.Report -> D.Doc

143reportToDoc :: FilePath -> Report.Report -> D.Doc

150−reportToDoc relativePath (Report.Report title _ _ message) =

144+reportToDoc path (Report.Report title _ _ message) =

151 D.vcat

145 D.vcat

152− [ toMessageBar title relativePath

146+ [ toMessageBar title path

153 , ""

147 , ""

154 , message

148 , message

155 , ""

149 , ""

@@ -179,8 +173,8 @@ toJson (Module name path _ source err) =

179 toReports (Code.toSource source) err

173 toReports (Code.toSource source) err

180 in

174 in

181 E.object

175 E.object

182− [ "path" ==> E.chars path

176+ [ "path" ==> E.string (Utf8.fromChars path)

183− , "name" ==> E.name name

177+ , "name" ==> E.string (Name.toUtf8 name)

184 , "problems" ==> E.array (map reportToJson (NE.toList reports))

178 , "problems" ==> E.array (map reportToJson (NE.toList reports))

185 ]

179 ]

186

180

@@ -188,7 +182,7 @@ toJson (Module name path _ source err) =

188reportToJson :: Report.Report -> E.Value

182reportToJson :: Report.Report -> E.Value

189reportToJson (Report.Report title region _sgstns message) =

183reportToJson (Report.Report title region _sgstns message) =

190 E.object

184 E.object

191− [ "title" ==> E.chars title

185+ [ "title" ==> E.string (Utf8.fromChars title)

192 , "region" ==> encodeRegion region

186 , "region" ==> encodeRegion region

193 , "message" ==> D.encode message

187 , "message" ==> D.encode message

194 ]

188 ]

@@ -199,12 +193,12 @@ encodeRegion (A.Region (A.Position sr sc) (A.Position er ec)) =

199 E.object

193 E.object

200 [ "start" ==>

194 [ "start" ==>

201 E.object

195 E.object

202− [ "line" ==> E.int (fromIntegral sr)

196+ [ ("line", E.int (fromIntegral sr))

203− , "column" ==> E.int (fromIntegral sc)

197+ , ("column", E.int (fromIntegral sc))

204 ]

198 ]

205 , "end" ==>

199 , "end" ==>

206 E.object

200 E.object

207− [ "line" ==> E.int (fromIntegral er)

201+ [ ("line", E.int (fromIntegral er))

208− , "column" ==> E.int (fromIntegral ec)

202+ , ("column", E.int (fromIntegral ec))

209 ]

203 ]

210 ]

204 ]

compiler/src/Reporting/Error/Canonicalize.hs+40−41

@@ -14,10 +14,8 @@ module Reporting.Error.Canonicalize

16import qualified Data.Char as Char

17−import qualified Data.List as List

18import qualified Data.Map as Map

17import qualified Data.Map as Map

19import qualified Data.Name as Name

18import qualified Data.Name as Name

20−import qualified Data.OneOrMore as OneOrMore

21import qualified Data.Set as Set

19import qualified Data.Set as Set

23import qualified AST.Canonical as Can

21import qualified AST.Canonical as Can

@@ -39,10 +37,10 @@ import qualified Reporting.Suggest as Suggest

40data Error

38data Error

41 = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int

39 = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int

42− | AmbiguousVar A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

40+ | AmbiguousVar A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]

43− | AmbiguousType A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

41+ | AmbiguousType A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]

44− | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

42+ | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]

45− | AmbiguousBinop A.Region Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

43+ | AmbiguousBinop A.Region Name.Name [ModuleName.Canonical]

46 | BadArity A.Region BadArityContext Name.Name Int Int

44 | BadArity A.Region BadArityContext Name.Name Int Int

47 | Binop A.Region Name.Name Name.Name

45 | Binop A.Region Name.Name Name.Name

48 | DuplicateDecl Name.Name A.Region A.Region

46 | DuplicateDecl Name.Name A.Region A.Region

@@ -166,17 +164,17 @@ toReport source err =

166 <> " be deleted? Maybe some parentheses are missing?"

164 <> " be deleted? Maybe some parentheses are missing?"

167 )

165 )

168

166

169− AmbiguousVar region maybePrefix name h hs ->

167+ AmbiguousVar region maybePrefix name possibleHomes ->

170− ambiguousName source region maybePrefix name h hs "variable"

168+ ambiguousName source region maybePrefix name possibleHomes "variable"

171

169

172− AmbiguousType region maybePrefix name h hs ->

170+ AmbiguousType region maybePrefix name possibleHomes ->

173− ambiguousName source region maybePrefix name h hs "type"

171+ ambiguousName source region maybePrefix name possibleHomes "type"

174

172

175− AmbiguousVariant region maybePrefix name h hs ->

173+ AmbiguousVariant region maybePrefix name possibleHomes ->

176− ambiguousName source region maybePrefix name h hs "variant"

174+ ambiguousName source region maybePrefix name possibleHomes "variant"

177

175

178− AmbiguousBinop region name h hs ->

176+ AmbiguousBinop region name possibleHomes ->

179− ambiguousName source region Nothing name h hs "operator"

177+ ambiguousName source region Nothing name possibleHomes "operator"

180

178

181 BadArity region badArityContext name expected actual ->

179 BadArity region badArityContext name expected actual ->

182 let

180 let

@@ -244,11 +242,11 @@ toReport source err =

244

242

245 DuplicateAliasArg typeName name r1 r2 ->

243 DuplicateAliasArg typeName name r1 r2 ->

246 nameClash source r1 r2 $

244 nameClash source r1 r2 $

247− "The `" <> Name.toChars typeName <> "` type alias has multiple `" <> Name.toChars name <> "` type variables."

245+ "The `" <> Name.toChars typeName <> "` type alias has multilpe `" <> Name.toChars name <> "` type variables."

248

246

249 DuplicateUnionArg typeName name r1 r2 ->

247 DuplicateUnionArg typeName name r1 r2 ->

250 nameClash source r1 r2 $

248 nameClash source r1 r2 $

251− "The `" <> Name.toChars typeName <> "` type has multiple `" <> Name.toChars name <> "` type variables."

249+ "The `" <> Name.toChars typeName <> "` type has multilpe `" <> Name.toChars name <> "` type variables."

252

250

253 DuplicatePattern context name r1 r2 ->

251 DuplicatePattern context name r1 r2 ->

254 nameClash source r1 r2 $

252 nameClash source r1 r2 $

@@ -276,7 +274,7 @@ toReport source err =

276 "You have declared that `" ++ Name.toChars name ++ "` is an effect type:"

274 "You have declared that `" ++ Name.toChars name ++ "` is an effect type:"

277 ,

275 ,

278 D.reflow $

276 D.reflow $

279− "But I cannot find a custom type named `" ++ Name.toChars name ++ "` in this file!"

277+ "But I cannot find a union type named `" ++ Name.toChars name ++ "` in this file!"

280 )

278 )

281

279

282 EffectFunctionNotFound region name ->

280 EffectFunctionNotFound region name ->

@@ -344,7 +342,7 @@ toReport source err =

344 Code.toSnippet source region Nothing

342 Code.toSnippet source region Nothing

345 (

343 (

346 D.reflow $

344 D.reflow $

347− "The (..) syntax is for exposing variants of a custom type. It cannot be used with a type alias like `"

345+ "The (..) syntax is for exposing union type constructors. It cannot be used with a type alias like `"

348 ++ Name.toChars name ++ "` though."

346 ++ Name.toChars name ++ "` though."

349 ,

347 ,

350 D.reflow $

348 D.reflow $

@@ -357,12 +355,12 @@ toReport source err =

357 (

355 (

358 D.reflow $

356 D.reflow $

359 "You are trying to import the `" <> Name.toChars ctor

357 "You are trying to import the `" <> Name.toChars ctor

360− <> "` variant by name:"

358+ <> "` type constructor by name:"

361 ,

359 ,

362 D.fillSep

360 D.fillSep

363 ["Try","importing",D.green (D.fromName tipe <> "(..)"),"instead."

361 ["Try","importing",D.green (D.fromName tipe <> "(..)"),"instead."

364 ,"The","dots","mean","“expose","the",D.fromName tipe,"type","and"

362 ,"The","dots","mean","“expose","the",D.fromName tipe,"type","and"

365− ,"all","its","variants","so","it","gives","you","access","to"

363+ ,"all","its","constructors”","so","it","gives","you","access","to"

366 , D.fromName ctor <> "."

364 , D.fromName ctor <> "."

367 ]

365 ]

368 )

366 )

@@ -388,8 +386,13 @@ toReport source err =

388 D.reflow $

386 D.reflow $

389 "The `" <> Name.toChars name <> "` type alias cannot be followed by (..) like this:"

387 "The `" <> Name.toChars name <> "` type alias cannot be followed by (..) like this:"

390 ,

388 ,

391− D.reflow $

389+ D.stack

392− "Remove the (..) and it should work."

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

393 )

396 )

394

397

395 ImportExposingNotFound region (ModuleName.Canonical _ home) value possibleNames ->

398 ImportExposingNotFound region (ModuleName.Canonical _ home) value possibleNames ->

@@ -519,7 +522,7 @@ toReport source err =

519 <> "` as a function, but it is not available in pattern matching like this:"

522 <> "` as a function, but it is not available in pattern matching like this:"

520 ,

523 ,

521 D.reflow $

524 D.reflow $

522− "I recommend matching the record as a variable and unpacking it later."

525+ "I recommend matching matching the record as a variable and unpacking it later."

523 )

526 )

524

527

525 PortPayloadInvalid region portName _badType invalidPayload ->

528 PortPayloadInvalid region portName _badType invalidPayload ->

@@ -679,7 +682,7 @@ toReport source err =

679 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."

682 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."

680 ,

683 ,

681 D.stack

684 D.stack

682− [ makeTheory "Are you trying to mutate a variable?" $

685+ [ makeTheory "Are you are trying to mutate a variable?" $

683 "Elm does not have mutation, so when I see " ++ Name.toChars name

686 "Elm does not have mutation, so when I see " ++ Name.toChars name

684 ++ " defined in terms of " ++ Name.toChars name

687 ++ " defined in terms of " ++ Name.toChars name

685 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"

688 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"

@@ -725,7 +728,7 @@ toReport source err =

725 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."

728 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."

726 ,

729 ,

727 D.stack

730 D.stack

728− [ makeTheory "Are you trying to mutate a variable?" $

731+ [ makeTheory "Are you are trying to mutate a variable?" $

729 "Elm does not have mutation, so when I see " ++ Name.toChars name

732 "Elm does not have mutation, so when I see " ++ Name.toChars name

730 ++ " defined in terms of " ++ Name.toChars name

733 ++ " defined in terms of " ++ Name.toChars name

731 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"

734 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"

@@ -976,32 +979,28 @@ nameClash source r1 r2 messageThatEndsWithPunctuation =

976-- AMBIGUOUS NAME

979-- AMBIGUOUS NAME

977

980

978

981

979−ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> ModuleName.Canonical -> OneOrMore.OneOrMore ModuleName.Canonical -> String -> Report.Report

982+ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> [ModuleName.Canonical] -> String -> Report.Report

980−ambiguousName source region maybePrefix name h hs thing =

983+ambiguousName source region maybePrefix name possibleHomes thing =

981− let

982− possibleHomes = List.sort (h : OneOrMore.destruct (:) hs)

983− in

984 Report.Report "AMBIGUOUS NAME" region [] $

985 Code.toSnippet source region Nothing $

986 case maybePrefix of

987 Nothing ->

988 let

989 homeToYellowDoc (ModuleName.Canonical _ home) =

990− D.dullyellow (D.fromName home <> "." <> D.fromName name)

990+ D.dullyellow (D.fromName home)

991+

992+ bothOrAll =

993+ if length possibleHomes == 2 then "both" else "all"

991 in

994 in

992 (

995 (

993− D.reflow $ "This usage of `" ++ Name.toChars name ++ "` is ambiguous:"

996+ D.reflow $ "This usage of `" ++ Name.toChars name ++ "` is ambiguous."

994 ,

997 ,

995 D.stack

998 D.stack

996 [ D.reflow $

999 [ D.reflow $

997− "This name is exposed by " ++ show (length possibleHomes) ++ " of your imports, so I am not\

1000+ "Check your imports. The following modules " ++ bothOrAll

998− \ sure which one to use:"

1001+ ++ " expose a `" ++ Name.toChars name ++ "` " ++ thing ++ ":"

999 , D.indent 4 $ D.vcat $ map homeToYellowDoc possibleHomes

1002 , D.indent 4 $ D.vcat $ map homeToYellowDoc possibleHomes

1000− , D.reflow $

1003+ , D.reflowLink "Read" "imports" "to learn how to clarify which one you want."

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."

1005 ]

1004 ]

1006 )

1005 )

1007

1006

@@ -1009,9 +1008,9 @@ ambiguousName source region maybePrefix name h hs thing =

1009 let

1008 let

1010 homeToYellowDoc (ModuleName.Canonical _ home) =

1009 homeToYellowDoc (ModuleName.Canonical _ home) =

1011 if prefix == home then

1010 if prefix == home then

1012− D.cyan "import" <+> D.fromName home

1011+ D.blue "import" <+> D.dullyellow (D.fromName home)

1013 else

1012 else

1014− D.cyan "import" <+> D.fromName home <+> D.cyan "as" <+> D.fromName prefix

1013+ D.blue "import" <+> D.dullyellow (D.fromName home) <+> D.blue "as" <+> D.dullyellow (D.fromName prefix)

1015

1014

1016 eitherOrAny =

1015 eitherOrAny =

1017 if length possibleHomes == 2 then "either" else "any"

1016 if length possibleHomes == 2 then "either" else "any"

compiler/src/Reporting/Error/Docs.hs+18−127

@@ -2,24 +2,17 @@

2{-# LANGUAGE OverloadedStrings #-}

3module Reporting.Error.Docs

4 ( Error(..)

5− , SyntaxProblem(..)

5+ , toReport

6− , NameProblem(..)

7− , DefProblem(..)

8− , toReports

9 )

6 )

10 where

7 where

13import qualified Data.Name as Name

10import qualified Data.Name as Name

14−import qualified Data.NonEmptyList as NE

16−import Parse.Primitives (Row, Col)

17−import Parse.Symbol (BadOperator(..))

18import qualified Reporting.Annotation as A

12import qualified Reporting.Annotation as A

19import Reporting.Doc ((<>))

13import Reporting.Doc ((<>))

20import qualified Reporting.Doc as D

14import qualified Reporting.Doc as D

21import qualified Reporting.Render.Code as Code

15import qualified Reporting.Render.Code as Code

22−import qualified Reporting.Error.Syntax as E

23import qualified Reporting.Report as Report

16import qualified Reporting.Report as Report

@@ -27,56 +20,36 @@ import qualified Reporting.Report as Report

27data Error

20data Error

28 = NoDocs A.Region

21 = NoDocs A.Region

29 | ImplicitExposing A.Region

22 | ImplicitExposing A.Region

30− | SyntaxProblem SyntaxProblem

23+ | Duplicate Name.Name A.Region A.Region

31− | NameProblems (NE.List NameProblem)

24+ | OnlyInDocs Name.Name A.Region

32− | DefProblems (NE.List DefProblem)

25+ | OnlyInExports Name.Name A.Region

33−

26+ | NoComment Name.Name A.Region

34−

35−data SyntaxProblem

36− = Op Row Col

37− | OpBad BadOperator Row Col

38− | Name Row Col

39− | Space E.Space Row Col

40− | Comma Row Col

41− | BadEnd Row Col

42−

43−

44−data NameProblem

45− = NameDuplicate Name.Name A.Region A.Region

46− | NameOnlyInDocs Name.Name A.Region

47− | NameOnlyInExports Name.Name A.Region

48−

49−

50−data DefProblem

51− = NoComment Name.Name A.Region

52 | NoAnnotation Name.Name A.Region

27 | NoAnnotation Name.Name A.Region

56−-- TO REPORTS

31+-- TO REPORT

59−toReports :: Code.Source -> Error -> NE.List Report.Report

34+toReport :: Code.Source -> Error -> Report.Report

60−toReports source err =

35+toReport source err =

61 case err of

36 case err of

62 NoDocs region ->

37 NoDocs region ->

63− NE.singleton $

64 Report.Report "NO DOCS" region [] $

38 Report.Report "NO DOCS" region [] $

65− Code.toSnippet source region Nothing

39+ D.stack

66− (

40+ [

67 D.reflow $

41 D.reflow $

68 "You must have a documentation comment between the module\

42 "You must have a documentation comment between the module\

69 \ declaration and the imports."

43 \ declaration and the imports."

70 ,

44 ,

71 D.reflow

45 D.reflow

72− "Learn more at <https://package.elm-lang.org/help/documentation-format>"

46+ "Learn more at <http://package.elm-lang.org/help/documentation-format>"

73− )

47+ ]

75 ImplicitExposing region ->

49 ImplicitExposing region ->

76− NE.singleton $

77 Report.Report "IMPLICIT EXPOSING" region [] $

50 Report.Report "IMPLICIT EXPOSING" region [] $

78− Code.toSnippet source region Nothing

51+ D.stack

79− (

52+ [

80 D.reflow $

53 D.reflow $

81 "I need you to be explicit about what this module exposes:"

54 "I need you to be explicit about what this module exposes:"

82 ,

55 ,

@@ -86,83 +59,9 @@ toReports source err =

86 \ to be explicit about this is a way of adding another quality check before\

59 \ to be explicit about this is a way of adding another quality check before\

87 \ code gets published. So as you write out the public API, ask yourself if\

60 \ code gets published. So as you write out the public API, ask yourself if\

88 \ it will be easy to understand as people read the documentation!"

61 \ it will be easy to understand as people read the documentation!"

89− )

62+ ]

90−

91− SyntaxProblem problem ->

92− NE.singleton $

93− toSyntaxProblemReport source problem

94−

95− NameProblems problems ->

96− fmap (toNameProblemReport source) problems

97−

98− DefProblems problems ->

99− fmap (toDefProblemReport source) problems

100−

101−

102−

103−-- SYNTAX PROBLEM

104−

105

106−toSyntaxProblemReport :: Code.Source -> SyntaxProblem -> Report.Report

64+ Duplicate name r1 r2 ->

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−

162−toNameProblemReport :: Code.Source -> NameProblem -> Report.Report

163−toNameProblemReport source problem =

164− case problem of

165− NameDuplicate name r1 r2 ->

166 Report.Report "DUPLICATE DOCS" r2 [] $

65 Report.Report "DUPLICATE DOCS" r2 [] $

167 Code.toPair source r1 r2

66 Code.toPair source r1 r2

168 (

67 (

@@ -182,7 +81,7 @@ toNameProblemReport source problem =

182 "Remove one of them!"

81 "Remove one of them!"

183 )

82 )

184

185− NameOnlyInDocs name region ->

84+ OnlyInDocs name region ->

186 Report.Report "DOCS MISTAKE" region [] $

85 Report.Report "DOCS MISTAKE" region [] $

187 Code.toSnippet source region Nothing

86 Code.toSnippet source region Nothing

188 (

87 (

@@ -195,7 +94,7 @@ toNameProblemReport source problem =

195 <> Name.toChars name <> "` and forgot to delete it here?"

94 <> Name.toChars name <> "` and forgot to delete it here?"

196 )

95 )

197

198− NameOnlyInExports name region ->

97+ OnlyInExports name region ->

199 Report.Report "DOCS MISTAKE" region [] $

98 Report.Report "DOCS MISTAKE" region [] $

200 Code.toSnippet source region Nothing

99 Code.toSnippet source region Nothing

201 (

100 (

@@ -211,14 +110,6 @@ toNameProblemReport source problem =

211 ]

110 ]

212 )

111 )

213

112

214−

215−

216−-- DEF PROBLEM

217−

218−

219−toDefProblemReport :: Code.Source -> DefProblem -> Report.Report

220−toDefProblemReport source problem =

221− case problem of

222 NoComment name region ->

113 NoComment name region ->

223 Report.Report "NO DOCS" region [] $

114 Report.Report "NO DOCS" region [] $

224 Code.toSnippet source region Nothing

115 Code.toSnippet source region Nothing

compiler/src/Reporting/Error/Import.hs+1−1

@@ -56,7 +56,7 @@ toReport source (Error region name unimportedModules problem) =

56 D.stack

57 [

58 D.reflow $

59− "I checked the \"dependencies\" and \"source-directories\" listed in your elm.json,\

59+ "I checked the \"dependencies\" and \"source-directories\" listend in your elm.json,\

60 \ but I cannot find it! Maybe it is a typo for one of these names?"

61 ,

62 D.dullyellow $ D.indent 4 $ D.vcat $

compiler/src/Reporting/Error/Json.hs+269−281

@@ -1,344 +1,332 @@

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

3module Reporting.Error.Json

4− ( toReport

4+ ( Error(..)

5− , FailureToReport(..)

5+ , Problem(..)

6− , Context(..)

6+ , DecodeExpectation(..)

7− , Reason(..)

7+ , ParseError(..)

8+ , toReport

8 )

9 )

9 where

10 where

12−import qualified Data.ByteString as BS

13+import qualified Data.Utf8 as Utf8

13−import qualified Data.ByteString.UTF8 as BS_UTF8

14+import Data.Word (Word16)

14−import qualified Data.NonEmptyList as NE

16−import Json.Decode (Error(..), Problem(..), DecodeExpectation(..), ParseError(..), StringProblem(..))

16+import qualified Reporting.Report as Report

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

24−-- TO REPORT

20+-- ERROR

27−toReport :: FilePath -> FailureToReport x -> Error x -> Reason -> Help.Report

23+data Error e

28−toReport path ftr err reason =

24+ = DecodeProblem (Problem e)

29− case err of

25+ | ParseProblem ParseError

30− DecodeProblem bytes problem ->

31− problemToReport path ftr (Code.toSource bytes) CRoot problem reason

33− ParseProblem bytes parseError ->

34− parseErrorToReport path (Code.toSource bytes) parseError reason

37−newtype Reason =

29+-- DECODE PROBLEMS

38− ExplicitReason String

41−because :: Reason -> String -> String

32+data Problem e

42−because (ExplicitReason iNeedThings) problem =

33+ = Field Utf8.String (Problem e)

43− iNeedThings ++ " " ++ problem

34+ | Index Int (Problem e)

35+ | OneOf (Problem e) [Problem e]

36+ | Failure e

37+ | Expecting DecodeExpectation

40+data DecodeExpectation

41+ = TObject

42+ | TArray

43+ | TString

44+ | TBool

45+ | TInt

46+ | TObjectWith Utf8.String

47+ | TArrayPair Int

47−-- PARSE ERROR TO REPORT

50−parseErrorToReport :: FilePath -> Code.Source -> ParseError -> Reason -> Help.Report

51+-- PARSE ERROR

51−parseErrorToReport path source parseError reason =

52− let

53− toSnippet title row col (problem, details) =

54− let

55− pos = A.Position row col

56− surroundings = A.Region (A.Position (max 1 (row - 2)) 1) pos

57− region = A.Region pos pos

58− in

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

71− D.stack

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!"

80− ]

81− )

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

101

102− ObjectColon row col ->

54+data ParseError

103− toSnippet "EXPECTING COLON" row col

55+ = PIndex Int ParseError Row Col

104− (

56+ | PField Utf8.String ParseError Row Col

105− "I was partway through parsing a JSON object when I got stuck here:"

57+ | ObjectStart Row Col

106− ,

58+ | ObjectMore Row Col

107− D.stack

59+ | ObjectEnd Row Col

108− [ D.reflow $ "I was expecting to see a colon next."

60+ | ArrayStart Row Col

109− , objectNote

61+ | ArrayMore Row Col

110− ]

62+ | ArrayEnd Row Col

111− )

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

112

113− ObjectEnd row col ->

74+

114− toSnippet "UNFINISHED OBJECT" row col

75+type Row = Word16

115− (

76+type Col = Word16

116− "I was partway through parsing a JSON object when I got stuck here:"

77+

117− ,

78+

118− D.stack

79+

80+-- TO REPORT

81+

82+

83+toReport :: Error e -> Report.Report

84+toReport err =

85+ error "TODO Reporting.Error.Json.toReport" err

86+

87+

88+{-

89+

90+-- ERROR

91+

92+

93+data Error e

94+ = BadJson Syntax.Error

95+ | BadContent (Json.Error e)

96+

97+

98+

99+-- TO DOC

100+

101+

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 $

119 [ D.reflow $

127 [ D.reflow $

120− "I was expecting to see a comma or a closing curly brace next."

128+ "I have " ++ show (length flatErrors) ++ " theories on what is going wrong:"

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 ]

129 ]

126− )

130+ ++ zipWith toNumberedDoc [1..] flatErrors

131+

132+

133+

134+-- FLAT ERROR TO DOC

127

135

128− ArrayEnd row col ->

136+

129− toSnippet "UNFINISHED ARRAY" row col

137+flatErrorToDoc :: String -> [D.Doc] -> (e -> [D.Doc]) -> FlatError e -> D.Doc

130− (

138+flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory theories) =

131− "I was partway through parsing a JSON array when I got stuck here:"

139+ case theories of

132− ,

140+ [] ->

141+ let

142+ explanation =

143+ case theory of

144+ Failure userError ->

145+ userErrorToDocs userError

146+

147+ Expecting tipe ->

148+ ["I","was","expecting"] ++ anExpectedThing tipe

149+ in

150+ case accesses of

151+ [] ->

152+ D.fillSep (starter ++ explanation)

153+

154+ _ ->

133 D.stack

155 D.stack

134− [ D.reflow $ "I was expecting to see a comma or a closing square bracket next."

156+ [ D.fillSep $ starter ++ ["The"] ++ actualThing json ++ ["at",accessToDoc rootName accesses,"is","causing","issues."]

135− , D.reflow $

157+ , D.fillSep explanation

136− "Is a comma missing on the previous line? It is often something like that!"

137 ]

158 ]

138− )

159+

139−

160+ _:_ ->

140− StringProblem stringProblem row col ->

161+ let

141− case stringProblem of

162+ introduction =

142− BadStringEnd ->

163+ case accesses of

143− toSnippet "ENDLESS STRING" row col

164+ [] ->

144− (

165+ ["I","am","having","trouble","with","the"]

145− "I got to the end of the line without seeing the closing double quote:"

166+ ++ actualThing json

146− ,

167+ ++ ["here","because:"]

147− D.fillSep $

168+

148− ["Strings","look","like",D.green "\"this\"","with","double"

169+ _ ->

149− ,"quotes","on","each","end.","Is","the","closing","double"

170+ ["I","am","having","trouble","with","the"]

150− ,"quote","missing","in","your","code?"

171+ ++ actualThing json

151− ]

172+ ++ ["at",accessToDoc rootName accesses,"because:"]

152− )

173+ in

153−

174+ D.stack

154− BadStringControlChar ->

175+ [ D.fillSep (starter ++ introduction)

155− toSnippet "UNEXPECTED CONTROL CHARACTER" row col

176+ , D.stack (toBullet [] userErrorToDocs theory : map (toBullet ["OR"] userErrorToDocs) theories)

156− (

177+ , D.reflow "I accept any of these things."

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 ]

178 ]

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

236

179

237

180

181+accessToDoc :: String -> [String] -> D.Doc

182+accessToDoc rootName accesses =

183+ D.dullyellow (D.fromString (rootName ++ concat accesses))

238

184

239−-- PROBLEM TO REPORT

240

185

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"]

241

196

242−data Context

243− = CRoot

244− | CField BS.ByteString Context

245− | CIndex Int Context

246

197

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

247

211

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

253

212

254− Index index prob ->

213+toBullet :: [D.Doc] -> (e -> [D.Doc]) -> Theory e -> D.Doc

255− problemToReport path ftr source (CIndex index context) prob reason

214+toBullet intro userErrorToDocs theory =

215+ D.indent 4 $ D.fillSep $ (++) intro $

216+ case theory of

217+ Failure userError ->

218+ userErrorToDocs userError

256

219

257− OneOf p ps ->

220+ Expecting tipe ->

258− -- NOTE: only displays the deepest problem. This works well for the kind

221+ ["I","was","expecting"] ++ anExpectedThing tipe

259− -- of JSON used by Elm, but probably would not work well in general.

222+

260− let

223+

261− (NE.List prob _) = NE.sortBy (negate . getMaxDepth) (NE.List p ps)

224+

262− in

225+-- TO FLAT ERRORS

263− problemToReport path ftr source context prob reason

264

226

265− Failure region x ->

266− _failureToReport ftr path source context region x

267

227

268− Expecting region expectation ->

228+data FlatError e =

269− expectationToReport path source context region expectation reason

229+ FlatError [String] E.Value (Theory e) [Theory e]

270

230

271

231

272−getMaxDepth :: Problem x -> Int

232+data Theory e

273−getMaxDepth problem =

233+ = Failure e

274− case problem of

234+ | Expecting Json.Type

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

280

235

281

236

282−newtype FailureToReport x =

237+flatten :: Json.Error e -> [FlatError e]

283− FailureToReport { _failureToReport :: FilePath -> Code.Source -> Context -> A.Region -> x -> Help.Report }

238+flatten jsonError =

239+ let

240+ depth (FlatError accesses _ _ _) =

241+ length accesses

242+ in

243+ List.sortOn depth $ flattenTree (toErrorTree jsonError)

284

244

285

245

286−expectationToReport :: FilePath -> Code.Source -> Context -> A.Region -> DecodeExpectation -> Reason -> Help.Report

246+flattenTree :: ErrorTree e -> [FlatError e]

287−expectationToReport path source context (A.Region start end) expectation reason =

247+flattenTree (ErrorTree theories subTrees) =

288 let

248 let

289− (A.Position sr _) = start

249+ addAccess access (FlatError accesses json t ts) =

290− (A.Position er _) = end

250+ FlatError (access:accesses) json t ts

291

251

292− region =

252+ toFlats (name, tree) =

293− if sr == er then region else A.Region start start

253+ map (addAccess name) (flattenTree tree)

254+

255+ subErrors =

256+ concatMap toFlats (Map.toList subTrees)

257+ in

258+ case theories of

259+ [] ->

260+ subErrors

294

261

295− introduction =

262+ (json, theory) : rest ->

296− case context of

263+ FlatError [] json theory (map snd rest) : subErrors

297− CRoot ->

298− "I ran into some trouble here:"

299

264

300− CField field _ ->

301− "I ran into trouble with the value of the \"" ++ BS_UTF8.toString field ++ "\" field:"

302

265

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:"

306

266

307− CIndex index _ ->

267+-- TO ERROR TREE

308− "I ran into trouble with the " ++ D.intToOrdinal index ++ " index of this array:"

309

268

310− toSnippet title aThing =

269+

311− Help.jsonReport title (Just path) $

270+data ErrorTree e =

312− Code.toSnippet source region Nothing

271+ ErrorTree

313− ( D.reflow (because reason introduction)

272+ { _theories :: [(E.Value, Theory e)]

314− , D.fillSep $ ["I","was","expecting","to","run","into"] ++ aThing

273+ , _subErrors :: Map.Map String (ErrorTree e)

315− )

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

316 in

311 in

317− case expectation of

312+ Map.alter subAdd name subErrors

318− TObject ->

319− toSnippet "EXPECTING OBJECT" ["an", D.green "OBJECT" <> "."]

320

313

321− TArray ->

322− toSnippet "EXPECTING ARRAY" ["an", D.green "ARRAY" <> "."]

323

314

324− TString ->

315+fieldToName :: Text.Text -> String

325− toSnippet "EXPECTING STRING" ["a", D.green "STRING" <> "."]

316+fieldToName field =

317+ case Text.unpack field of

318+ [] ->

319+ "['']"

326

320

327− TBool ->

321+ string@(char : rest) ->

328− toSnippet "EXPECTING BOOL" ["a", D.green "BOOLEAN" <> "."]

322+ if Char.isAlpha char && all Char.isAlphaNum rest then

323+ '.' : string

324+ else

325+ "['" ++ string ++ "']"

329

326

330− TInt ->

331− toSnippet "EXPECTING INT" ["an", D.green "INT" <> "."]

332

327

333− TObjectWith field ->

328+indexToName :: Int -> String

334− toSnippet "MISSING FIELD"

329+indexToName index =

335− ["an",D.green "OBJECT","with","a"

330+ "[" ++ show index ++ "]"

336− ,D.green ("\"" <> D.fromChars (BS_UTF8.toString field) <> "\"")

337− ,"field."

338− ]

339

331

340− TArrayPair len ->

332+-}

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+4−5

@@ -8,7 +8,6 @@ module Reporting.Error.Pattern

9import qualified Data.List as List

11−import qualified Elm.String as ES

12import qualified Nitpick.PatternMatches as P

11import qualified Nitpick.PatternMatches as P

13import Reporting.Doc ((<>))

12import Reporting.Doc ((<>))

14import qualified Reporting.Doc as D

13import qualified Reporting.Doc as D

@@ -41,7 +40,7 @@ toReport source err =

41 Report.Report "UNSAFE PATTERN" region [] $

40 Report.Report "UNSAFE PATTERN" region [] $

42 Code.toSnippet source region Nothing

41 Code.toSnippet source region Nothing

43 (

42 (

44− "This pattern does not cover all possibilities:"

43+ "This pattern does not cover all possiblities:"

45 ,

44 ,

46 D.stack

45 D.stack

47 [ "Other possibilities include:"

46 [ "Other possibilities include:"

@@ -64,7 +63,7 @@ toReport source err =

64 , unhandledPatternsToDocBlock unhandled

63 , unhandledPatternsToDocBlock unhandled

65 , D.reflow $

64 , D.reflow $

66 "I would have to crash if I saw one of those! You can use\

65 "I would have to crash if I saw one of those! You can use\

67− \ `let` to deconstruct values only if there is ONE possibility.\

66+ \ `let` to deconstruct values only if there is ONE possiblity.\

68 \ Switch to a `case` expression to account for all possibilities."

67 \ Switch to a `case` expression to account for all possibilities."

69 , D.toSimpleHint $

68 , D.toSimpleHint $

70 "Are you calling a function that definitely returns values\

69 "Are you calling a function that definitely returns values\

@@ -118,10 +117,10 @@ patternToDoc context pattern =

118 NonList (P.Literal literal) ->

117 NonList (P.Literal literal) ->

119 case literal of

118 case literal of

120 P.Chr chr ->

119 P.Chr chr ->

121− "'" <> D.fromChars (ES.toChars chr) <> "'"

120+ "'" <> D.fromUtf8 chr <> "'"

122

121

123 P.Str str ->

122 P.Str str ->

124− "\"" <> D.fromChars (ES.toChars str) <> "\""

123+ "\"" <> D.fromUtf8 str <> "\""

125

124

126 P.Int int ->

125 P.Int int ->

127 D.fromInt int

126 D.fromInt int

compiler/src/Reporting/Error/Syntax.hs+460−1036

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

2{-# LANGUAGE OverloadedStrings #-}

3module Reporting.Error.Syntax

4 ( Error(..)

5− , toReport

6 --

5 --

7 , Module(..)

6 , Module(..)

8 , Exposing(..)

7 , Exposing(..)

@@ -40,7 +39,7 @@ module Reporting.Error.Syntax

40 , Number(..)

39 , Number(..)

41 --

40 --

42 , Space(..)

41 , Space(..)

43− , toSpaceReport

42+ , toReport

44 )

43 )

45 where

44 where

@@ -69,9 +68,6 @@ data Error

69 | ModuleNameMismatch ModuleName.Raw (A.Located ModuleName.Raw)

68 | ModuleNameMismatch ModuleName.Raw (A.Located ModuleName.Raw)

70 | UnexpectedPort A.Region

69 | UnexpectedPort A.Region

71 | NoPorts A.Region

70 | NoPorts A.Region

72− | NoPortsInPackage (A.Located Name.Name)

73− | NoPortModulesInPackage A.Region

74− | NoEffectsOutsideKernel A.Region

75 | ParseError Module

71 | ParseError Module

@@ -81,7 +77,7 @@ data Error

82data Module

78data Module

83 = ModuleSpace Space Row Col

79 = ModuleSpace Space Row Col

84− | ModuleBadEnd Row Col

80+ | ModuleEndOfFile Row Col

85 --

81 --

86 | ModuleProblem Row Col

82 | ModuleProblem Row Col

87 | ModuleName Row Col

83 | ModuleName Row Col

@@ -520,7 +516,7 @@ toReport source err =

520 ,

516 ,

521 D.stack

517 D.stack

522 [ D.reflow $

518 [ D.reflow $

523− "I need it to match the file path, so I was expecting to see `"

519+ "I need it to match the file path, so I was expecting it to see `"

524 ++ ModuleName.toChars expectedName

520 ++ ModuleName.toChars expectedName

525 ++ "` here. Make the following change, and you should be all set!"

521 ++ "` here. Make the following change, and you should be all set!"

526 , D.indent 4 $

522 , D.indent 4 $

@@ -564,94 +560,75 @@ toReport source err =

564 ]

560 ]

565 )

561 )

566

562

567− NoPortsInPackage (A.At region _) ->

568− Report.Report "PACKAGES CANNOT HAVE PORTS" region [] $

569− Code.toSnippet source region Nothing

570− (

571− D.reflow $

572− "Packages cannot declare any ports, so I am getting stuck here:"

573− ,

574− D.stack

575− [ D.reflow $

576− "Remove this port declaration."

577− , noteForPortsInPackage

578− ]

579− )

580−

581− NoPortModulesInPackage region ->

582− Report.Report "PACKAGES CANNOT HAVE PORTS" region [] $

583− Code.toSnippet source region Nothing

584− (

585− D.reflow $

586− "Packages cannot declare any ports, so I am getting stuck here:"

587− ,

588− D.stack

589− [ D.fillSep $

590− ["Remove","the",D.cyan "port","keyword","and","I"

591− ,"should","be","able","to","continue."

592− ]

593− , noteForPortsInPackage

594− ]

595− )

596−

597− NoEffectsOutsideKernel region ->

598− Report.Report "INVALID EFFECT MODULE" region [] $

599− Code.toSnippet source region Nothing

600− (

601− D.reflow $

602− "It is not possible to declare an `effect module` outside the @elm organization,\

603− \ so I am getting stuck here:"

604− ,

605− D.stack

606− [ D.reflow $

607− "Switch to a normal module declaration."

608− , D.toSimpleNote $

609− "Effect modules are designed to allow certain core functionality to be\

610− \ defined separately from the compiler. So the @elm organization has access to\

611− \ this so that certain changes, extensions, and fixes can be introduced without\

612− \ needing to release new Elm binaries. For example, we want to make it possible\

613− \ to test effects, but this may require changes to the design of effect modules.\

614− \ By only having them defined in the @elm organization, that kind of design work\

615− \ can proceed much more smoothly."

616− ]

617− )

618−

619 ParseError modul ->

563 ParseError modul ->

620 toParseErrorReport source modul

564 toParseErrorReport source modul

621

565

622

566

623−noteForPortsInPackage :: D.Doc

624−noteForPortsInPackage =

625− D.stack

626− [ D.toSimpleNote $

627− "One of the major goals of the package ecosystem is to be completely written\

628− \ in Elm. This means when you install an Elm package, you can be sure you are safe\

629− \ from security issues on install and that you are not going to get any runtime\

630− \ exceptions coming from your new dependency. This design also sets the ecosystem\

631− \ up to target other platforms more easily (like mobile phones, WebAssembly, etc.)\

632− \ since no community code explicitly depends on JavaScript even existing."

633− , D.reflow $

634− "Given that overall goal, allowing ports in packages would lead to some pretty\

635− \ surprising behavior. If ports were allowed in packages, you could install a\

636− \ package but not realize that it brings in an indirect dependency that defines a\

637− \ port. Now you have a program that does not work and the fix is to realize that\

638− \ some JavaScript needs to be added for a dependency you did not even know about.\

639− \ That would be extremely frustrating! \"So why not allow the package author to\

640− \ include the necessary JS code as well?\" Now we are back in conflict with our\

641− \ overall goal to keep all community packages free from runtime exceptions."

642− ]

643−

644−

645toParseErrorReport :: Code.Source -> Module -> Report.Report

567toParseErrorReport :: Code.Source -> Module -> Report.Report

646toParseErrorReport source modul =

568toParseErrorReport source modul =

647 case modul of

569 case modul of

648 ModuleSpace space row col ->

570 ModuleSpace space row col ->

649 toSpaceReport source space row col

571 toSpaceReport source space row col

650

572

651− ModuleBadEnd row col ->

573+ ModuleEndOfFile row col ->

652− if col == 1

574+ case Code.whatIsNext source row col of

653− then toDeclStartReport source row col

575+ Code.Keyword keyword ->

654− else toWeirdEndReport source row col

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

655

632

656 ModuleProblem row col ->

633 ModuleProblem row col ->

657 let

634 let

@@ -797,15 +774,15 @@ toParseErrorReport source modul =

797 [ D.reflow $

774 [ D.reflow $

798 "I am not sure what is going on, but I recommend starting an Elm\

775 "I am not sure what is going on, but I recommend starting an Elm\

799 \ file with the following lines:"

776 \ file with the following lines:"

800− , D.indent 4 $ D.vcat $

777+ , D.vcat

801 [ D.fillSep [D.cyan "import","Html"]

778 [ D.fillSep [D.cyan "import","Html"]

802 , ""

779 , ""

803− , "main ="

780+ , D.fillSep [D.green "main","="]

804− , " Html.text " <> D.dullyellow "\"Hello!\""

781+ , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]

805 ]

782 ]

806 , D.reflow $

783 , D.reflow $

807− "You should be able to copy those lines directly into your file. Check out the\

784+ "You should be able to copy those lines directly into your file. Check out\

808− \ examples at <https://elm-lang.org/examples> for more help getting started!"

785+ \ some of the examples on https://elm-lang.org for more help getting started!"

809 , D.toSimpleNote $

786 , D.toSimpleNote $

810 "This can also happen when something is indented too much!"

787 "This can also happen when something is indented too much!"

811 ]

788 ]

@@ -830,12 +807,11 @@ toParseErrorReport source modul =

830 , D.indent 4 $ D.vcat $

807 , D.indent 4 $ D.vcat $

831 [ D.fillSep [D.cyan "import","Dict"]

808 [ D.fillSep [D.cyan "import","Dict"]

832 , D.fillSep [D.cyan "import","Maybe"]

809 , D.fillSep [D.cyan "import","Maybe"]

833− , D.fillSep [D.cyan "import","Html.Attributes",D.cyan "as","A"]

810+ , D.fillSep [D.cyan "import","Html.Attributes"]

834− , D.fillSep [D.cyan "import","Json.Decode",D.cyan "exposing","(..)"]

811+ , D.fillSep [D.cyan "import","Json.Decode"]

835 ]

812 ]

836 , D.reflow $

813 , D.reflow $

837 "Notice that the module names all start with capital letters. That is required!"

814 "Notice that the module names all start with capital letters. That is required!"

838− , D.reflowLink "Read" "imports" "to learn more."

839 ]

815 ]

840 )

816 )

841

817

@@ -846,7 +822,7 @@ toParseErrorReport source modul =

846 let

822 let

847 region = toRegion row col

823 region = toRegion row col

848 in

824 in

849− Report.Report "EXPECTING IMPORT ALIAS" region [] $

825+ Report.Report "EXECTING IMPORT ALIAS" region [] $

850 Code.toSnippet source region Nothing

826 Code.toSnippet source region Nothing

851 (

827 (

852 D.reflow $

828 D.reflow $

@@ -862,7 +838,6 @@ toParseErrorReport source modul =

862 ]

838 ]

863 , D.reflow $

839 , D.reflow $

864 "Notice that the alias always starts with a capital letter. That is required!"

840 "Notice that the alias always starts with a capital letter. That is required!"

865− , D.reflowLink "Read" "imports" "to learn more."

866 ]

841 ]

867 )

842 )

868

843

@@ -925,192 +900,6 @@ toParseErrorReport source modul =

925

900

926

901

927

902

928−-- WEIRD END

929−

930−

931−toWeirdEndReport :: Code.Source -> Row -> Col -> Report.Report

932−toWeirdEndReport source row col =

933− case Code.whatIsNext source row col of

934− Code.Keyword keyword ->

935− let

936− region = toKeywordRegion row col keyword

937− in

938− Report.Report "RESERVED WORD" region [] $

939− Code.toSnippet source region Nothing

940− (

941− D.reflow $

942− "I got stuck on this reserved word:"

943− ,

944− D.reflow $

945− "The name `" ++ keyword ++ "` is reserved, so try using a different name?"

946− )

947−

948− Code.Operator op ->

949− let

950− region = toKeywordRegion row col op

951− in

952− Report.Report "UNEXPECTED SYMBOL" region [] $

953− Code.toSnippet source region Nothing

954− (

955− D.reflow $

956− "I ran into an unexpected symbol:"

957− ,

958− D.reflow $

959− "I was not expecting to see a " ++ op ++ " here. Try deleting it? Maybe\

960− \ I can give a better hint from there?"

961− )

962−

963− Code.Close term bracket ->

964− let

965− region = toRegion row col

966− in

967− Report.Report ("UNEXPECTED " ++ map Char.toUpper term) region [] $

968− Code.toSnippet source region Nothing

969− (

970− D.reflow $

971− "I ran into an unexpected " ++ term ++ ":"

972− ,

973− D.reflow $

974− "This " ++ bracket : " does not match up with an earlier open " ++ term ++ ". Try deleting it?"

975− )

976−

977− Code.Lower c cs ->

978− let

979− region = toKeywordRegion row col (c:cs)

980− in

981− Report.Report "UNEXPECTED NAME" region [] $

982− Code.toSnippet source region Nothing

983− (

984− D.reflow $

985− "I got stuck on this name:"

986− ,

987− D.reflow $

988− "It is confusing me a lot! Normally I can give fairly specific hints, but\

989− \ something is really tripping me up this time."

990− )

991−

992− Code.Upper c cs ->

993− let

994− region = toKeywordRegion row col (c:cs)

995− in

996− Report.Report "UNEXPECTED NAME" region [] $

997− Code.toSnippet source region Nothing

998− (

999− D.reflow $

1000− "I got stuck on this name:"

1001− ,

1002− D.reflow $

1003− "It is confusing me a lot! Normally I can give fairly specific hints, but\

1004− \ something is really tripping me up this time."

1005− )

1006−

1007− Code.Other maybeChar ->

1008− let

1009− region = toRegion row col

1010− in

1011− case maybeChar of

1012− Just ';' ->

1013− Report.Report "UNEXPECTED SEMICOLON" region [] $

1014− Code.toSnippet source region Nothing

1015− (

1016− D.reflow $

1017− "I got stuck on this semicolon:"

1018− ,

1019− D.stack

1020− [ D.reflow $ "Try removing it?"

1021− , D.toSimpleNote $

1022− "Some languages require semicolons at the end of each statement. These are\

1023− \ often called C-like languages, and they usually share a lot of language design\

1024− \ choices. (E.g. side-effects, for loops, etc.) Elm manages effects with commands\

1025− \ and subscriptions instead, so there is no special syntax for \"statements\" and\

1026− \ therefore no need to use semicolons to separate them. I think this will make\

1027− \ more sense as you work through <https://guide.elm-lang.org> though!"

1028− ]

1029− )

1030−

1031− Just ',' ->

1032− Report.Report "UNEXPECTED COMMA" region [] $

1033− Code.toSnippet source region Nothing

1034− (

1035− D.reflow $

1036− "I got stuck on this comma:"

1037− ,

1038− D.stack

1039− [ D.reflow $

1040− "I do not think I am parsing a list or tuple right now. Try deleting the comma?"

1041− , D.toSimpleNote $

1042− "If this is supposed to be part of a list, the problem may be a bit earlier.\

1043− \ Perhaps the opening [ is missing? Or perhaps some value in the list has an extra\

1044− \ closing ] that is making me think the list ended earlier? The same kinds of\

1045− \ things could be going wrong if this is supposed to be a tuple."

1046− ]

1047− )

1048−

1049− Just '`' ->

1050− Report.Report "UNEXPECTED CHARACTER" region [] $

1051− Code.toSnippet source region Nothing

1052− (

1053− D.reflow $

1054− "I got stuck on this character:"

1055− ,

1056− D.stack

1057− [ D.reflow $

1058− "It is not used for anything in Elm syntax. It is used for multi-line strings in\

1059− \ some languages though, so if you want a string that spans multiple lines, you\

1060− \ can use Elm's multi-line string syntax like this:"

1061− , D.dullyellow $ D.indent 4 $ D.vcat $

1062− [ "\"\"\""

1063− , "# Multi-line Strings"

1064− , ""

1065− , "- start with triple double quotes"

1066− , "- write whatever you want"

1067− , "- no need to escape newlines or double quotes"

1068− , "- end with triple double quotes"

1069− , "\"\"\""

1070− ]

1071− , D.reflow $

1072− "Otherwise I do not know what is going on! Try removing the character?"

1073− ]

1074− )

1075−

1076− Just '$' ->

1077− Report.Report "UNEXPECTED SYMBOL" region [] $

1078− Code.toSnippet source region Nothing

1079− (

1080− D.reflow $

1081− "I got stuck on this dollar sign:"

1082− ,

1083− D.reflow $

1084− "It is not used for anything in Elm syntax. Are you coming from a language where\

1085− \ dollar signs can be used in variable names? If so, try a name that (1) starts\

1086− \ with a letter and (2) only contains letters, numbers, and underscores."

1087− )

1088−

1089− Just c | elem c ['#','@','!','%','~'] ->

1090− Report.Report "UNEXPECTED SYMBOL" region [] $

1091− Code.toSnippet source region Nothing

1092− (

1093− D.reflow $

1094− "I got stuck on this symbol:"

1095− ,

1096− D.reflow $

1097− "It is not used for anything in Elm syntax. Try removing it?"

1098− )

1099−

1100− _ ->

1101− Report.Report "SYNTAX PROBLEM" region [] $

1102− Code.toSnippet source region Nothing

1103− (

1104− D.reflow $

1105− "I got stuck here:"

1106− ,

1107− D.reflow $

1108− "Whatever I am running into is confusing me a lot! Normally I can give fairly\

1109− \ specific hints, but something is really tripping me up this time."

1110− )

1111−

1112−

1113−

1114-- IMPORTS

903-- IMPORTS

1115

904

1116

905

@@ -1136,7 +925,6 @@ toImportReport source row col =

1136 ]

925 ]

1137 , D.reflow $

926 , D.reflow $

1138 "You are probably trying to import a different module, but try to make it look like one of these examples!"

927 "You are probably trying to import a different module, but try to make it look like one of these examples!"

1139− , D.reflowLink "Read" "imports" "to learn more."

1140 ]

928 ]

1141 )

929 )

1142

930

@@ -1443,7 +1231,106 @@ toDeclarationsReport :: Code.Source -> Decl -> Report.Report

1443toDeclarationsReport source decl =

1231toDeclarationsReport source decl =

1444 case decl of

1232 case decl of

1445 DeclStart row col ->

1233 DeclStart row col ->

1446− toDeclStartReport source 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+ )

1447

1334

1448 DeclSpace space row col ->

1335 DeclSpace space row col ->

1449 toSpaceReport source space row col

1336 toSpaceReport source space row col

@@ -1473,165 +1360,6 @@ toDeclarationsReport source decl =

1473 )

1360 )

1474

1361

1475

1362

1476−toDeclStartReport :: Code.Source -> Row -> Col -> Report.Report

1477−toDeclStartReport source row col =

1478− case Code.whatIsNext source row col of

1479− Code.Close term bracket ->

1480− let

1481− region = toRegion row col

1482− in

1483− Report.Report ("STRAY " ++ map Char.toUpper term) region [] $

1484− Code.toSnippet source region Nothing

1485− (

1486− D.reflow $

1487− "I was not expecting to see a " ++ term ++ " here:"

1488− , D.reflow $

1489− "This " ++ bracket : " does not match up with an earlier open " ++ term ++ ". Try deleting it?"

1490− )

1491−

1492− Code.Keyword keyword ->

1493− let

1494− region = toKeywordRegion row col keyword

1495− in

1496− Report.Report "RESERVED WORD" region [] $

1497− Code.toSnippet source region Nothing

1498− (

1499− D.reflow $

1500− "I was not expecting to run into the `" ++ keyword ++ "` keyword here:"

1501− ,

1502− case keyword of

1503− "import" ->

1504− D.reflow $

1505− "It is reserved for declaring imports at the top of your module. If you want\

1506− \ another import, try moving it up top with the other imports. If you want to\

1507− \ define a value or function, try changing the name to something else!"

1508−

1509− "case" ->

1510− D.stack

1511− [ D.reflow $

1512− "It is reserved for writing `case` expressions. Try using a different name?"

1513− , D.toSimpleNote $

1514− "If you are trying to write a `case` expression, it needs to be part of a\

1515− \ definition. So you could write something like this instead:"

1516− , D.indent 4 $ D.vcat $

1517− [ D.indent 0 $ D.fillSep ["getWidth","maybeWidth","="]

1518− , D.indent 2 $ D.fillSep [D.cyan "case","maybeWidth",D.cyan "of"]

1519− , D.indent 4 $ D.fillSep [D.blue "Just","width","->"]

1520− , D.indent 6 $ D.fillSep ["width","+",D.dullyellow "200"]

1521− , ""

1522− , D.indent 4 $ D.fillSep [D.blue "Nothing","->"]

1523− , D.indent 6 $ D.fillSep [D.dullyellow "400"]

1524− ]

1525− , D.reflow $

1526− "This defines a `getWidth` function that you can use elsewhere in your program."

1527− ]

1528−

1529− "if" ->

1530− D.stack

1531− [ D.reflow $

1532− "It is reserved for writing `if` expressions. Try using a different name?"

1533− , D.toSimpleNote $

1534− "If you are trying to write an `if` expression, it needs to be part of a\

1535− \ definition. So you could write something like this instead:"

1536− , D.indent 4 $ D.vcat $

1537− [ "greet name ="

1538− , D.fillSep $

1539− [" "

1540− ,D.cyan "if","name","==",D.dullyellow "\"Abraham Lincoln\""

1541− ,D.cyan "then",D.dullyellow "\"Greetings Mr. President.\""

1542− ,D.cyan "else",D.dullyellow "\"Hey!\""

1543− ]

1544− ]

1545− , D.reflow $

1546− "This defines a `reviewPowerLevel` function that you can use elsewhere in your program."

1547− ]

1548−

1549− _ ->

1550− D.reflow $

1551− "It is a reserved word. Try changing the name to something else?"

1552− )

1553−

1554− Code.Upper c cs ->

1555− let

1556− region = toRegion row col

1557− in

1558− Report.Report "UNEXPECTED CAPITAL LETTER" region [] $

1559− Code.toSnippet source region Nothing

1560− (

1561− D.reflow $

1562− "Declarations always start with a lower-case letter, so I am getting stuck here:"

1563− ,

1564− D.stack

1565− [ D.fillSep $

1566− ["Try","a","name","like"

1567− ,D.green (D.fromChars (Char.toLower c : cs))

1568− ,"instead?"

1569− ]

1570− , D.toSimpleNote $

1571− "Here are a couple valid declarations for reference:"

1572− , D.indent 4 $ D.vcat $

1573− [ "greet : String -> String"

1574− , "greet name ="

1575− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

1576− , ""

1577− , D.cyan "type" <> " User = Anonymous | LoggedIn String"

1578− ]

1579− , D.reflow $

1580− "Notice that they always start with a lower-case letter. Capitalization matters!"

1581− ]

1582− )

1583−

1584− Code.Other (Just char) | elem char ['(', '{', '[', '+', '-', '*', '/', '^', '&', '|', '"', '\'', '!', '@', '#', '$', '%'] ->

1585− let

1586− region = toRegion row col

1587− in

1588− Report.Report "UNEXPECTED SYMBOL" region [] $

1589− Code.toSnippet source region Nothing

1590− (

1591− D.reflow $

1592− "I am getting stuck because this line starts with the " ++ [char] ++ " symbol:"

1593− ,

1594− D.stack

1595− [ D.reflow $

1596− "When a line has no spaces at the beginning, I expect it to be a declaration like one of these:"

1597− , D.indent 4 $ D.vcat $

1598− [ "greet : String -> String"

1599− , "greet name ="

1600− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

1601− , ""

1602− , D.cyan "type" <> " User = Anonymous | LoggedIn String"

1603− ]

1604− , D.reflow $

1605− "If this is not supposed to be a declaration, try adding some spaces before it?"

1606− ]

1607− )

1608−

1609− _ ->

1610− let

1611− region = toRegion row col

1612− in

1613− Report.Report "WEIRD DECLARATION" region [] $

1614− Code.toSnippet source region Nothing

1615− (

1616− D.reflow $

1617− "I am trying to parse a declaration, but I am getting stuck here:"

1618− ,

1619− D.stack

1620− [ D.reflow $

1621− "When a line has no spaces at the beginning, I expect it to be a declaration like one of these:"

1622− , D.indent 4 $ D.vcat $

1623− [ "greet : String -> String"

1624− , "greet name ="

1625− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

1626− , ""

1627− , D.cyan "type" <> " User = Anonymous | LoggedIn String"

1628− ]

1629− , D.reflow $

1630− "Try to make your declaration look like one of those? Or if this is not\

1631− \ supposed to be a declaration, try adding some spaces before it?"

1632− ]

1633− )

1634−

1635

1363

1636-- PORT

1364-- PORT

1637

1365

@@ -1758,7 +1486,7 @@ toPortReport source port_ startRow startCol =

1758 [ D.reflow $

1486 [ D.reflow $

1759 "I was expecting to see a type next. Here are examples of outgoing and\

1487 "I was expecting to see a type next. Here are examples of outgoing and\

1760 \ incoming ports for reference:"

1488 \ incoming ports for reference:"

1761− , D.indent 4 $ D.vcat $

1489+ , D.vcat

1762 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]

1490 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]

1763 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]

1491 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]

1764 ]

1492 ]

@@ -1777,7 +1505,7 @@ portNote =

1777 D.stack

1505 D.stack

1778 [ D.toSimpleNote $

1506 [ D.toSimpleNote $

1779 "Here are some example `port` declarations for reference:"

1507 "Here are some example `port` declarations for reference:"

1780− , D.indent 4 $ D.vcat $

1508+ , D.vcat

1781 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]

1509 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]

1782 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]

1510 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]

1783 ]

1511 ]

@@ -1907,7 +1635,7 @@ toTypeAliasReport source typeAlias startRow startCol =

1907 ,

1635 ,

1908 D.stack

1636 D.stack

1909 [ D.reflow $

1637 [ D.reflow $

1910− "I was expecting to see a type variable or an equals sign next."

1638+ "I was expecting to see a type variable or an an equals sign next."

1911 , typeAliasNote

1639 , typeAliasNote

1912 ]

1640 ]

1913 )

1641 )

@@ -1928,7 +1656,7 @@ toTypeAliasReport source typeAlias startRow startCol =

1928 ,

1656 ,

1929 D.stack

1657 D.stack

1930 [ D.reflow $

1658 [ D.reflow $

1931− "I was expecting to see a type variable or an equals sign next."

1659+ "I was expecting to see a type variable or an an equals sign next."

1932 , typeAliasNote

1660 , typeAliasNote

1933 ]

1661 ]

1934 )

1662 )

@@ -1960,8 +1688,8 @@ typeAliasNote =

1960 [ D.toSimpleNote $

1688 [ D.toSimpleNote $

1961 "Here is an example of a valid `type alias` for reference:"

1689 "Here is an example of a valid `type alias` for reference:"

1962 , D.vcat $

1690 , D.vcat $

1963− [ D.indent 4 $ D.fillSep [D.cyan "type",D.cyan "alias","Person","="]

1691+ [ D.indent 0 $ D.fillSep [D.cyan "type",D.cyan "alias",D.green "Person","="]

1964− , D.indent 6 $ D.vcat $

1692+ , D.indent 2 $ D.vcat $

1965 ["{ name : String"

1693 ["{ name : String"

1966 ,", age : Int"

1694 ,", age : Int"

1967 ,", height : Float"

1695 ,", height : Float"

@@ -2035,7 +1763,7 @@ toCustomTypeReport source customType startRow startCol =

2035 ,

1763 ,

2036 D.stack

1764 D.stack

2037 [ D.reflow $

1765 [ D.reflow $

2038− "I was expecting to see a type variable or an equals sign next."

1766+ "I was expecting to see a type variable or an an equals sign next."

2039 , customTypeNote

1767 , customTypeNote

2040 ]

1768 ]

2041 )

1769 )

@@ -2095,7 +1823,7 @@ toCustomTypeReport source customType startRow startCol =

2095 ,

1823 ,

2096 D.stack

1824 D.stack

2097 [ D.reflow $

1825 [ D.reflow $

2098− "I was expecting to see a type variable or an equals sign next."

1826+ "I was expecting to see a type variable or an an equals sign next."

2099 , customTypeNote

1827 , customTypeNote

2100 ]

1828 ]

2101 )

1829 )

@@ -2161,10 +1889,10 @@ customTypeNote =

2161 [ D.toSimpleNote $

1889 [ D.toSimpleNote $

2162 "Here is an example of a valid `type` declaration for reference:"

1890 "Here is an example of a valid `type` declaration for reference:"

2163 , D.vcat $

1891 , D.vcat $

2164− [ D.indent 4 $ D.fillSep [D.cyan "type","Status"]

1892+ [ D.indent 0 $ D.fillSep [D.cyan "type",D.green "Status"]

2165− , D.indent 6 $ D.fillSep ["=","Failure"]

1893+ , D.indent 2 $ D.fillSep ["=","Failure"]

2166− , D.indent 6 $ D.fillSep ["|","Waiting"]

1894+ , D.indent 2 $ D.fillSep ["|","Waiting"]

2167− , D.indent 6 $ D.fillSep ["|","Success","String"]

1895+ , D.indent 2 $ D.fillSep ["|","Success","String"]

2168 ]

1896 ]

2169 , D.reflow $

1897 , D.reflow $

2170 "This defines a new `Status` type with three variants. This could be useful if\

1898 "This defines a new `Status` type with three variants. This could be useful if\

@@ -2193,57 +1921,13 @@ toDeclDefReport source name declDef startRow startCol =

2193 region = toKeywordRegion row col keyword

1921 region = toKeywordRegion row col keyword

2194 in

1922 in

2195 Report.Report "RESERVED WORD" region [] $

1923 Report.Report "RESERVED WORD" region [] $

2196− Code.toSnippet source surroundings (Just region)

2197− (

2198− D.fillSep

2199− ["The","name"

2200− ,"`" <> D.cyan (D.fromChars keyword) <> "`"

2201− ,"is","reserved","in","Elm,","so","it","cannot"

2202− ,"be","used","as","an","argument","here:"

2203− ]

2204− ,

2205− D.stack

2206− [ D.reflow $

2207− "Try renaming it to something else."

2208− , case keyword of

2209− "as" ->

2210− D.toFancyNote

2211− ["This","keyword","is","reserved","for","pattern","matches","like"

2212− ,"((x,y)",D.cyan "as","point)","where","you","want","to","name","a","tuple","and"

2213− ,"the","values","it","contains."

2214− ]

2215−

2216− _ ->

2217− D.toSimpleNote $

2218− "The `" ++ keyword ++ "` keyword has a special meaning in Elm, so it can only be used in certain situations."

2219− ]

2220− )

2221−

2222− Code.Operator "->" ->

2223− let

2224− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

2225− region = toWiderRegion row col 2

2226− in

2227− Report.Report "MISSING COLON?" region [] $

2228 Code.toSnippet source surroundings (Just region)

1924 Code.toSnippet source surroundings (Just region)

2229 (

1925 (

2230 D.reflow $

1926 D.reflow $

2231− "I was not expecting to see an arrow here:"

1927+ "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"

2232 ,

1928 ,

2233− D.stack

1929+ D.reflow $

2234− [ D.fillSep

1930+ "This is a reserved word! Try using some other name?"

2235− ["This","usually","means","a",D.green ":","is","missing","a","bit","earlier","in"

2236− ,"a","type","annotation.","It","could","be","something","else","though,","so"

2237− ,"here","is","a","valid","definition","for","reference:"

2238− ]

2239− , D.indent 4 $ D.vcat $

2240− [ "greet : String -> String"

2241− , "greet name ="

2242− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

2243− ]

2244− , D.reflow $

2245− "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"

2246− ]

2247 )

1931 )

2248

1932

2249 Code.Operator op ->

1933 Code.Operator op ->

@@ -2261,10 +1945,10 @@ toDeclDefReport source name declDef startRow startCol =

2261 [ D.reflow $

1945 [ D.reflow $

2262 "I am not sure what is going wrong exactly, so here is a valid\

1946 "I am not sure what is going wrong exactly, so here is a valid\

2263 \ definition (with an optional type annotation) for reference:"

1947 \ definition (with an optional type annotation) for reference:"

2264− , D.indent 4 $ D.vcat $

1948+ , D.vcat

2265− [ "greet : String -> String"

1949+ [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

2266− , "greet name ="

1950+ , D.fillSep [D.green "add","x","y","="]

2267− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

1951+ , D.fillSep [" ","x","+","y"]

2268 ]

1952 ]

2269 , D.reflow $

1953 , D.reflow $

2270 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"

1954 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"

@@ -2286,10 +1970,10 @@ toDeclDefReport source name declDef startRow startCol =

2286 [ D.reflow $

1970 [ D.reflow $

2287 "I am not sure what is going wrong exactly, so here is a valid\

1971 "I am not sure what is going wrong exactly, so here is a valid\

2288 \ definition (with an optional type annotation) for reference:"

1972 \ definition (with an optional type annotation) for reference:"

2289− , D.indent 4 $ D.vcat $

1973+ , D.vcat

2290− [ "greet : String -> String"

1974+ [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

2291− , "greet name ="

1975+ , D.fillSep [D.green "add","x","y","="]

2292− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

1976+ , D.fillSep [" ","x","+","y"]

2293 ]

1977 ]

2294 , D.reflow $

1978 , D.reflow $

2295 "Try to use that format!"

1979 "Try to use that format!"

@@ -2404,10 +2088,10 @@ declDefNote =

2404 D.stack

2088 D.stack

2405 [ D.reflow $

2089 [ D.reflow $

2406 "Here is a valid definition (with a type annotation) for reference:"

2090 "Here is a valid definition (with a type annotation) for reference:"

2407− , D.indent 4 $ D.vcat $

2091+ , D.vcat

2408− [ "greet : String -> String"

2092+ [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

2409− , "greet name ="

2093+ , D.fillSep [D.green "add","x","y","="]

2410− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

2094+ , D.fillSep [" ","x","+","y"]

2411 ]

2095 ]

2412 , D.reflow $

2096 , D.reflow $

2413 "The top line (called a \"type annotation\") is optional. You can leave it off\

2097 "The top line (called a \"type annotation\") is optional. You can leave it off\

@@ -2519,40 +2203,25 @@ toExprReport source context expr startRow startCol =

2519 )

2203 )

2520

2204

2521 OperatorRight op row col ->

2205 OperatorRight op row col ->

2522− let

2206+ let region = toRegion row col in

2523− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

2524− region = toRegion row col

2525− isMath = elem op ["-","+","*","/","^"]

2526− in

2527 Report.Report "MISSING EXPRESSION" region [] $

2207 Report.Report "MISSING EXPRESSION" region [] $

2528− Code.toSnippet source surroundings (Just region)

2208+ Code.toSnippet source region Nothing

2529 (

2209 (

2530 D.reflow $

2210 D.reflow $

2531− "I just saw a " ++ Name.toChars op ++ " "

2211+ "I was expecting to see an expression after this " ++ Name.toChars op ++ " operator:"

2532− ++ (if isMath then "sign" else "operator")

2533− ++ ", so I am getting stuck here:"

2534 ,

2212 ,

2535− if isMath then

2213+ D.stack

2536− D.fillSep

2214+ [ D.fillSep $

2537− ["I","was","expecting","to","see","an","expression","next."

2215+ ["You","can","just","put","anything","for","now,","like"

2538− ,"Something","like",D.dullyellow "42","or",D.dullyellow "1000"

2216+ ,D.dullyellow "42","or",D.dullyellow"\"hello\"" <> "."

2539− ,"that","makes","sense","with","a",D.fromName op,"sign."

2217+ ,"Once","there","is","something","there,","I","can","probably"

2540− ]

2218+ ,"give","a","more","specific","hint!"

2541− else if op == "&&" || op == "||" then

2219+ ]

2542− D.fillSep

2220+ , D.toSimpleNote $

2543− ["I","was","expecting","to","see","an","expression","next."

2221+ "This can also happen if run into reserved words like `let` or `as` unexpectedly.\

2544− ,"Something","like",D.dullyellow "True","or",D.dullyellow "False"

2222+ \ Or if I run into operators in unexpected spots. Point is, there are a\

2545− ,"that","makes","sense","with","boolean","logic."

2223+ \ couple ways I can get confused and give sort of weird advice!"

2546− ]

2224+ ]

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."

2556 )

2225 )

2557

2226

2558 OperatorReserved operator row col ->

2227 OperatorReserved operator row col ->

@@ -2573,6 +2242,7 @@ toExprReport source context expr startRow startCol =

2573 InNode NElse r c _ -> (r, c, "an `if` expression")

2242 InNode NElse r c _ -> (r, c, "an `if` expression")

2574 InNode NCase r c _ -> (r, c, "a `case` expression")

2243 InNode NCase r c _ -> (r, c, "a `case` expression")

2575 InNode NBranch r c _ -> (r, c, "a `case` expression")

2244 InNode NBranch r c _ -> (r, c, "a `case` expression")

2245+ -- TODO check if this is actually the best way to get error messages here

2576

2246

2577 surroundings = A.Region (A.Position contextRow contextCol) (A.Position row col)

2247 surroundings = A.Region (A.Position contextRow contextCol) (A.Position row col)

2578 region = toRegion row col

2248 region = toRegion row col

@@ -2591,7 +2261,7 @@ toExprReport source context expr startRow startCol =

2591 ,"give","a","more","specific","hint!"

2261 ,"give","a","more","specific","hint!"

2592 ]

2262 ]

2593 , D.toSimpleNote $

2263 , D.toSimpleNote $

2594− "This can also happen if I run into reserved words like `let` or `as` unexpectedly.\

2264+ "This can also happen if run into reserved words like `let` or `as` unexpectedly.\

2595 \ Or if I run into operators in unexpected spots. Point is, there are a\

2265 \ Or if I run into operators in unexpected spots. Point is, there are a\

2596 \ couple ways I can get confused and give sort of weird advice!"

2266 \ couple ways I can get confused and give sort of weird advice!"

2597 ]

2267 ]

@@ -2737,19 +2407,7 @@ toStringReport source string row col =

2737 ,"quotes","on","each","end.","Is","the","closing","double"

2407 ,"quotes","on","each","end.","Is","the","closing","double"

2738 ,"quote","missing","in","your","code?"

2408 ,"quote","missing","in","your","code?"

2739 ]

2409 ]

2740− , D.toSimpleNote $

2410+ , D.link "Note" "Read" "TODO" "if you want a string that spans multiple lines."

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

2753 ]

2411 ]

2754 )

2412 )

2755

2413

@@ -2765,18 +2423,7 @@ toStringReport source string row col =

2765 ,

2423 ,

2766 D.stack

2424 D.stack

2767 [ D.reflow "Add a \"\"\" somewhere after this to end the string."

2425 [ D.reflow "Add a \"\"\" somewhere after this to end the string."

2768− , D.toSimpleNote $

2426+ , D.link "Hint" "Read" "TODO" "for more information on strings and multi-line strings."

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

2780 ]

2427 ]

2781 )

2428 )

2782

2429

@@ -3009,41 +2656,33 @@ toOperatorReport source context operator row col =

3009 in

2656 in

3010 Report.Report "UNEXPECTED ARROW" region [] $

2657 Report.Report "UNEXPECTED ARROW" region [] $

3011 Code.toSnippet source region Nothing $

2658 Code.toSnippet source region Nothing $

3012− if isWithin NCase context then

2659+ if isWithin NBranch context then

3013− (

3014− D.reflow $

3015− "I am parsing a `case` expression right now, but this arrow is confusing me:"

3016− ,

3017− D.stack

3018− [ D.reflow "Maybe the `of` keyword is missing on a previous line?"

3019− , noteForCaseError

3020− ]

3021− )

3022−

3023− else if isWithin NBranch context then

3024 (

2660 (

3025 D.reflow $

2661 D.reflow $

3026− "I am parsing a `case` expression right now, but this arrow is confusing me:"

2662+ "I was not expecting to see an arrow here:"

3027 ,

2663 ,

3028 D.stack

2664 D.stack

3029− [ D.reflow $

2665+ [

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?"

2666+ D.reflow $

3031− , noteForCaseIndentError

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?"

3032 ]

2675 ]

3033 )

2676 )

3034

2677

3035 else

2678 else

3036 (

2679 (

3037 D.reflow $

2680 D.reflow $

3038− "I was partway through parsing an expression when I got stuck on this arrow:"

2681+ "I was not expecting an arrow here:"

3039 ,

2682 ,

3040− D.stack

2683+ D.reflow $

3041− [ "Arrows should only appear in `case` expressions and anonymous functions.\n\

2684+ "Arrows should only appear in `case` expressions and anonymous functions. Maybe\

3042− \Maybe it was supposed to be a > sign instead?"

2685+ \ you want > or >= instead?"

3043− , D.toSimpleNote $

3044− "The syntax for anonymous functions is (\\x -> x + 1) so the arguments all appear\

3045− \ after the backslash and before the arrow. Maybe a backslash is missing earlier?"

3046− ]

3047 )

2686 )

3048

2687

3049 BadEquals ->

2688 BadEquals ->

@@ -3170,7 +2809,7 @@ toLetReport source context let_ startRow startCol =

3170 , D.toSimpleNote $

2809 , D.toSimpleNote $

3171 "This can also happen if you are trying to define another value within the `let` but\

2810 "This can also happen if you are trying to define another value within the `let` but\

3172 \ it is not indented enough. Make sure each definition has exactly the same amount of\

2811 \ it is not indented enough. Make sure each definition has exactly the same amount of\

3173− \ spaces before it. They should line up exactly!"

2812+ \ spaces before it. The should line up exactly!"

3174 ]

2813 ]

3175 )

2814 )

3176

2815

@@ -3240,8 +2879,8 @@ toUnfinishLetReport source row col startRow startCol message =

3240 [ message

2879 [ message

3241 , D.toSimpleNote $

2880 , D.toSimpleNote $

3242 "Here is an example with a valid `let` expression for reference:"

2881 "Here is an example with a valid `let` expression for reference:"

3243− , D.indent 4 $ D.vcat $

2882+ , D.vcat $

3244− [ D.indent 0 $ D.fillSep ["viewPerson","person","="]

2883+ [ D.indent 0 $ D.fillSep [D.green "viewPerson","person","="]

3245 , D.indent 2 $ D.fillSep [D.cyan "let"]

2884 , D.indent 2 $ D.fillSep [D.cyan "let"]

3246 , D.indent 4 $ D.fillSep ["fullName","="]

2885 , D.indent 4 $ D.fillSep ["fullName","="]

3247 , D.indent 6 $ D.fillSep ["person.firstName","++",D.dullyellow "\" \"","++","person.lastName"]

2886 , D.indent 6 $ D.fillSep ["person.firstName","++",D.dullyellow "\" \"","++","person.lastName"]

@@ -3316,57 +2955,13 @@ toLetDefReport source name def startRow startCol =

3316 region = toKeywordRegion row col keyword

2955 region = toKeywordRegion row col keyword

3317 in

2956 in

3318 Report.Report "RESERVED WORD" region [] $

2957 Report.Report "RESERVED WORD" region [] $

3319− Code.toSnippet source surroundings (Just region)

3320− (

3321− D.fillSep

3322− ["The","name"

3323− ,"`" <> D.cyan (D.fromChars keyword) <> "`"

3324− ,"is","reserved","in","Elm,","so","it","cannot"

3325− ,"be","used","as","an","argument","here:"

3326− ]

3327− ,

3328− D.stack

3329− [ D.reflow $

3330− "Try renaming it to something else."

3331− , case keyword of

3332− "as" ->

3333− D.toFancyNote

3334− ["This","keyword","is","reserved","for","pattern","matches","like"

3335− ,"((x,y)",D.cyan "as","point)","where","you","want","to","name","a","tuple","and"

3336− ,"the","values","it","contains."

3337− ]

3338−

3339− _ ->

3340− D.toSimpleNote $

3341− "The `" ++ keyword ++ "` keyword has a special meaning in Elm, so it can only be used in certain situations."

3342− ]

3343− )

3344−

3345− Code.Operator "->" ->

3346− let

3347− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

3348− region = toWiderRegion row col 2

3349− in

3350− Report.Report "MISSING COLON?" region [] $

3351 Code.toSnippet source surroundings (Just region)

2958 Code.toSnippet source surroundings (Just region)

3352 (

2959 (

3353 D.reflow $

2960 D.reflow $

3354− "I was not expecting to see an arrow here:"

2961+ "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"

3355 ,

2962 ,

3356− D.stack

2963+ D.reflow $

3357− [ D.fillSep

2964+ "This is a reserved word! Try using some other name?"

3358− ["This","usually","means","a",D.green ":","is","missing","a","bit","earlier","in"

3359− ,"a","type","annotation.","It","could","be","something","else","though,","so"

3360− ,"here","is","a","valid","definition","for","reference:"

3361− ]

3362− , D.indent 4 $ D.vcat $

3363− [ "greet : String -> String"

3364− , "greet name ="

3365− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

3366− ]

3367− , D.reflow $

3368− "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"

3369− ]

3370 )

2965 )

3371

2966

3372 Code.Operator op ->

2967 Code.Operator op ->

@@ -3384,10 +2979,10 @@ toLetDefReport source name def startRow startCol =

3384 [ D.reflow $

2979 [ D.reflow $

3385 "I am not sure what is going wrong exactly, so here is a valid\

2980 "I am not sure what is going wrong exactly, so here is a valid\

3386 \ definition (with an optional type annotation) for reference:"

2981 \ definition (with an optional type annotation) for reference:"

3387− , D.indent 4 $ D.vcat $

2982+ , D.vcat

3388− [ "greet : String -> String"

2983+ [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

3389− , "greet name ="

2984+ , D.indent 4 $ D.fillSep [D.green "add","x","y","="]

3390− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

2985+ , D.indent 6 $ D.fillSep ["x","+","y"]

3391 ]

2986 ]

3392 , D.reflow $

2987 , D.reflow $

3393 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"

2988 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"

@@ -3409,10 +3004,10 @@ toLetDefReport source name def startRow startCol =

3409 [ D.reflow $

3004 [ D.reflow $

3410 "I am not sure what is going wrong exactly, so here is a valid\

3005 "I am not sure what is going wrong exactly, so here is a valid\

3411 \ definition (with an optional type annotation) for reference:"

3006 \ definition (with an optional type annotation) for reference:"

3412− , D.indent 4 $ D.vcat $

3007+ , D.vcat

3413− [ "greet : String -> String"

3008+ [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

3414− , "greet name ="

3009+ , D.indent 4 $ D.fillSep [D.green "add","x","y","="]

3415− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

3010+ , D.indent 4 $ D.fillSep ["x","+","y"]

3416 ]

3011 ]

3417 , D.reflow $

3012 , D.reflow $

3418 "Try to use that format!"

3013 "Try to use that format!"

@@ -3502,10 +3097,10 @@ defNote =

3502 D.stack

3097 D.stack

3503 [ D.reflow $

3098 [ D.reflow $

3504 "Here is a valid definition (with a type annotation) for reference:"

3099 "Here is a valid definition (with a type annotation) for reference:"

3505− , D.indent 4 $ D.vcat $

3100+ , D.vcat

3506− [ "greet : String -> String"

3101+ [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

3507− , "greet name ="

3102+ , D.indent 4 $ D.fillSep [D.green "add","x","y","="]

3508− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

3103+ , D.indent 6 $ D.fillSep ["x","+","y"]

3509 ]

3104 ]

3510 , D.reflow $

3105 , D.reflow $

3511 "The top line (called a \"type annotation\") is optional. You can leave it off\

3106 "The top line (called a \"type annotation\") is optional. You can leave it off\

@@ -3668,10 +3263,9 @@ toCaseReport source context case_ startRow startCol =

3668 D.reflow $

3263 D.reflow $

3669 "I am partway through parsing a `case` expression, but I got stuck here:"

3264 "I am partway through parsing a `case` expression, but I got stuck here:"

3670 ,

3265 ,

3671− D.stack

3266+ addNoteForCaseIndentError $

3672− [ D.reflow "I was expecting to see an arrow next."

3267+ D.reflow $

3673− , noteForCaseIndentError

3268+ "I was expecting to see an arrow next."

3674− ]

3675 )

3269 )

3676

3270

3677 CaseExpr expr row col ->

3271 CaseExpr expr row col ->

@@ -3719,39 +3313,34 @@ toUnfinishCaseReport source row col startRow startCol message =

3719 in

3313 in

3720 Report.Report "UNFINISHED CASE" region [] $

3314 Report.Report "UNFINISHED CASE" region [] $

3721 Code.toSnippet source surroundings (Just region)

3315 Code.toSnippet source surroundings (Just region)

3722− (

3316+ (

3723− D.reflow $

3317+ D.reflow $

3724− "I was partway through parsing a `case` expression, but I got stuck here:"

3318+ "I was partway through parsing a `case` expression, but I got stuck here:"

3725− ,

3319+ ,

3726− D.stack

3320+ D.stack

3727− [ message

3321+ [ message

3728− , noteForCaseError

3322+ , D.toSimpleNote $

3729− ]

3323+ "Here is an example of a valid `case` expression for reference."

3730− )

3324+ , D.vcat $

3731−

3325+ [ D.indent 4 $ D.fillSep [D.cyan "case","maybeWidth",D.cyan "of"]

3732−

3326+ , D.indent 6 $ D.fillSep [D.blue "Just","width","->"]

3733−noteForCaseError :: D.Doc

3327+ , D.indent 8 $ D.fillSep ["width","+",D.dullyellow "200"]

3734−noteForCaseError =

3328+ , ""

3735− D.stack

3329+ , D.indent 6 $ D.fillSep [D.blue "Nothing","->"]

3736− [ D.toSimpleNote $

3330+ , D.indent 8 $ D.fillSep [D.dullyellow "400"]

3737− "Here is an example of a valid `case` expression for reference."

3331+ ]

3738− , D.vcat $

3332+ , D.reflow $

3739− [ D.indent 4 $ D.fillSep [D.cyan "case","maybeWidth",D.cyan "of"]

3333+ "Notice the indentation. Each pattern is aligned, and each branch is indented\

3740− , D.indent 6 $ D.fillSep [D.blue "Just","width","->"]

3334+ \ a bit more than the corresponding pattern. That is important!"

3741− , D.indent 8 $ D.fillSep ["width","+",D.dullyellow "200"]

3335+ ]

3742− , ""

3336+ )

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

3337

3751

3338

3752−noteForCaseIndentError :: D.Doc

3339+addNoteForCaseIndentError :: D.Doc -> D.Doc

3753−noteForCaseIndentError =

3340+addNoteForCaseIndentError message =

3754− D.stack

3341+ D.stack $

3342+ message

3343+ :

3755 [ D.toSimpleNote $

3344 [ D.toSimpleNote $

3756 "Sometimes I get confused by indentation, so try to make your `case` look\

3345 "Sometimes I get confused by indentation, so try to make your `case` look\

3757 \ something like this:"

3346 \ something like this:"

@@ -3764,9 +3353,8 @@ noteForCaseIndentError =

3764 , D.indent 8 $ D.fillSep [D.dullyellow "400"]

3353 , D.indent 8 $ D.fillSep [D.dullyellow "400"]

3765 ]

3354 ]

3766 , D.reflow $

3355 , D.reflow $

3767− "Notice the indentation! Patterns are aligned with each other. Same indentation.\

3356+ "Notice the indentation! Each pattern is aligned, and each branch is indented\

3768− \ The expressions after each arrow are all indented a bit more than the patterns.\

3357+ \ a bit more than the corresponding pattern. That is important!"

3769− \ That is important!"

3770 ]

3358 ]

3771

3359

3772

3360

@@ -3918,43 +3506,23 @@ toIfReport source context if_ startRow startCol =

3918 )

3506 )

3919

3507

3920 IfIndentElse row col ->

3508 IfIndentElse row col ->

3921− case Code.nextLineStartsWithKeyword "else" source row of

3509+ let

3922− Just (elseRow, elseCol) ->

3510+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

3923− let

3511+ region = toRegion row col

3924− surroundings = A.Region (A.Position startRow startCol) (A.Position elseRow elseCol)

3512+ in

3925− region = toWiderRegion elseRow elseCol 4

3513+ Report.Report "UNFINISHED IF" region [] $

3926− in

3514+ Code.toSnippet source surroundings (Just region)

3927− Report.Report "WEIRD ELSE BRANCH" region [] $

3515+ (

3928− Code.toSnippet source surroundings (Just region)

3516+ D.reflow $

3929− (

3517+ "I was expecting to see an `else` branch after this:"

3930− D.reflow $

3518+ ,

3931− "I was partway through an `if` expression when I got stuck here:"

3519+ D.stack

3932− ,

3520+ [ D.reflow $

3933− D.fillSep $

3521+ "I know what to do when the condition is `True`, but not when it is `False`."

3934− ["I","think","this",D.cyan "else","keyword","needs","to","be","indented","more."

3522+ , D.fillSep

3935− ,"Try","adding","some","spaces","before","it."

3523+ ["Add","an",D.cyan "else","branch","to","handle","that","scenario!"]

3936− ]

3524+ ]

3937− )

3525+ )

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

3958

3526

3959

3527

3960

3528

@@ -3987,22 +3555,15 @@ toRecordReport source context record startRow startCol =

3987 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

3555 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

3988 region = toRegion row col

3556 region = toRegion row col

3989 in

3557 in

3990− Report.Report "PROBLEM IN RECORD" region [] $

3558+ Report.Report "UNFINISHED RECORD" region [] $

3991 Code.toSnippet source surroundings (Just region)

3559 Code.toSnippet source surroundings (Just region)

3992 (

3560 (

3993 D.reflow $

3561 D.reflow $

3994 "I just started parsing a record, but I got stuck here:"

3562 "I just started parsing a record, but I got stuck here:"

3995 ,

3563 ,

3996− D.stack

3564+ D.fillSep

3997− [ D.fillSep

3565+ ["Records","look","like",D.dullyellow "{ x = 3, y = 4 },"

3998− ["I","was","expecting","to","see","a","record","field","defined","next,"

3566+ ,"so","I","was","expecting","to","see","a","field","name","next."

3999− ,"so","I","am","looking","for","a","name","like"

4000− ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."

4001− ]

4002− , D.toSimpleNote $

4003− "Field names must start with a lower-case letter. After that, you can use\

4004− \ any sequence of letters, numbers, and underscores."

4005− , noteForRecordError

4006 ]

3567 ]

4007 )

3568 )

4008

3569

@@ -4011,7 +3572,7 @@ toRecordReport source context record startRow startCol =

4011 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

3572 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

4012 region = toRegion row col

3573 region = toRegion row col

4013 in

3574 in

4014− Report.Report "PROBLEM IN RECORD" region [] $

3575+ Report.Report "UNFINISHED RECORD" region [] $

4015 Code.toSnippet source surroundings (Just region)

3576 Code.toSnippet source surroundings (Just region)

4016 (

3577 (

4017 D.reflow $

3578 D.reflow $

@@ -4046,67 +3607,22 @@ toRecordReport source context record startRow startCol =

4046 \ that is a reserved word. Try using a different name!"

3607 \ that is a reserved word. Try using a different name!"

4047 )

3608 )

4048

3609

4049− Code.Other (Just ',') ->

4050− let

4051− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

4052− region = toRegion row col

4053− in

4054− Report.Report "EXTRA COMMA" region [] $

4055− Code.toSnippet source surroundings (Just region)

4056− (

4057− D.reflow $

4058− "I am partway through parsing a record, but I got stuck here:"

4059− ,

4060− D.stack

4061− [ D.reflow $

4062− "I am seeing two commas in a row. This is the second one!"

4063− , D.reflow $

4064− "Just delete one of the commas and you should be all set!"

4065− , noteForRecordError

4066− ]

4067− )

4068−

4069− Code.Close _ '}' ->

4070− let

4071− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

4072− region = toRegion row col

4073− in

4074− Report.Report "EXTRA COMMA" region [] $

4075− Code.toSnippet source surroundings (Just region)

4076− (

4077− D.reflow $

4078− "I am partway through parsing a record, but I got stuck here:"

4079− ,

4080− D.stack

4081− [ D.reflow $

4082− "Trailing commas are not allowed in records. Try deleting the comma that appears\

4083− \ before this closing curly brace."

4084− , noteForRecordError

4085− ]

4086− )

4087−

4088 _ ->

3610 _ ->

4089 let

3611 let

4090 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

3612 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

4091 region = toRegion row col

3613 region = toRegion row col

4092 in

3614 in

4093− Report.Report "PROBLEM IN RECORD" region [] $

3615+ Report.Report "UNFINISHED RECORD" region [] $

4094 Code.toSnippet source surroundings (Just region)

3616 Code.toSnippet source surroundings (Just region)

4095 (

3617 (

4096 D.reflow $

3618 D.reflow $

4097− "I am partway through parsing a record, but I got stuck here:"

3619+ "I am partway through parsing a record, but I got stuck after that last comma:"

4098 ,

3620 ,

4099− D.stack

3621+ addNoteForRecordError $

4100− [ D.fillSep

3622+ D.reflow $

4101− ["I","was","expecting","to","see","another","record","field","defined","next,"

3623+ "Trailing commas are not allowed in records, so I was expecting to see another\

4102− ,"so","I","am","looking","for","a","name","like"

3624+ \ record field defined next. If you are done defining the record, the fix may\

4103− ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."

3625+ \ be to delete that last comma?"

4104− ]

4105− , D.toSimpleNote $

4106− "Field names must start with a lower-case letter. After that, you can use\

4107− \ any sequence of letters, numbers, and underscores."

4108− , noteForRecordError

4109− ]

4110 )

3626 )

4111

3627

4112 RecordEquals row col ->

3628 RecordEquals row col ->

@@ -4114,19 +3630,17 @@ toRecordReport source context record startRow startCol =

4114 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

3630 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

4115 region = toRegion row col

3631 region = toRegion row col

4116 in

3632 in

4117− Report.Report "PROBLEM IN RECORD" region [] $

3633+ Report.Report "UNFINISHED RECORD" region [] $

4118 Code.toSnippet source surroundings (Just region)

3634 Code.toSnippet source surroundings (Just region)

4119 (

3635 (

4120 D.reflow $

3636 D.reflow $

4121 "I am partway through parsing a record, but I got stuck here:"

3637 "I am partway through parsing a record, but I got stuck here:"

4122 ,

3638 ,

4123− D.stack

3639+ addNoteForRecordError $

4124− [ D.fillSep $

3640+ D.fillSep $

4125− ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"

3641+ ["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?"

3642+ ,"an","equals","sign","next.","So","try","putting","an",D.green "=","sign","here?"

4127− ]

3643+ ]

4128− , noteForRecordError

4129− ]

4130 )

3644 )

4131

3645

4132 RecordExpr expr row col ->

3646 RecordExpr expr row col ->

@@ -4146,54 +3660,29 @@ toRecordReport source context record startRow startCol =

4146 D.reflow $

3660 D.reflow $

4147 "I just saw the opening curly brace of a record, but then I got stuck here:"

3661 "I just saw the opening curly brace of a record, but then I got stuck here:"

4148 ,

3662 ,

4149− D.stack

3663+ addNoteForRecordIndentError $

4150− [ D.fillSep $

3664+ D.fillSep $

4151− ["I","am","expecting","a","record","like",D.dullyellow "{ x = 3, y = 4 }","here."

3665+ ["I","am","expecting","a","record","like",D.dullyellow "{ x = 3, y = 4 }","here."

4152− ,"Try","defining","some","fields","of","your","own?"

3666+ ,"Try","defining","some","fields","of","your","own?"

4153− ]

3667+ ]

4154− , noteForRecordIndentError

4155− ]

4156 )

3668 )

4157

3669

4158 RecordIndentEnd row col ->

3670 RecordIndentEnd row col ->

4159− case Code.nextLineStartsWithCloseCurly source row of

3671+ let

4160− Just (curlyRow, curlyCol) ->

3672+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

4161− let

3673+ region = toRegion row col

4162− surroundings = A.Region (A.Position startRow startCol) (A.Position curlyRow curlyCol)

3674+ in

4163− region = toRegion curlyRow curlyCol

3675+ Report.Report "UNFINISHED RECORD" region [] $

4164− in

3676+ Code.toSnippet source surroundings (Just region)

4165− Report.Report "NEED MORE INDENTATION" region [] $

3677+ (

4166− Code.toSnippet source surroundings (Just region)

3678+ D.reflow $

4167− (

3679+ "I was expecting to see a closing curly brace next:"

4168− D.reflow $

3680+ ,

4169− "I was partway through parsing a record, but I got stuck here:"

3681+ addNoteForRecordIndentError $

4170− ,

3682+ D.fillSep $

4171− D.stack

3683+ ["Try","putting","an",D.green "}","and","see","if","that","helps?"

4172− [ D.reflow $

3684+ ]

4173− "I need this curly brace to be indented more. Try adding some spaces before it!"

3685+ )

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

4197

3686

4198 RecordIndentField row col ->

3687 RecordIndentField row col ->

4199 let

3688 let

@@ -4206,13 +3695,11 @@ toRecordReport source context record startRow startCol =

4206 D.reflow $

3695 D.reflow $

4207 "I am partway through parsing a record, but I got stuck after that last comma:"

3696 "I am partway through parsing a record, but I got stuck after that last comma:"

4208 ,

3697 ,

4209− D.stack

3698+ addNoteForRecordError $

4210− [ D.reflow $

3699+ D.reflow $

4211− "Trailing commas are not allowed in records, so the fix may be to\

3700+ "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\

3701+ \ delete that last comma? Or maybe you were in the middle of defining\

4213− \ an additional field?"

3702+ \ an additional field?"

4214− , noteForRecordError

4215− ]

4216 )

3703 )

4217

3704

4218 RecordIndentEquals row col ->

3705 RecordIndentEquals row col ->

@@ -4227,12 +3714,10 @@ toRecordReport source context record startRow startCol =

4227 "I am partway through parsing a record. I just saw a record\

3714 "I am partway through parsing a record. I just saw a record\

4228 \ field, so I was expecting to see an equals sign next:"

3715 \ field, so I was expecting to see an equals sign next:"

4229 ,

3716 ,

4230− D.stack

3717+ addNoteForRecordIndentError $

4231− [ D.fillSep $

3718+ D.fillSep $

4232− ["Try","putting","an",D.green "=","followed","by","an","expression?"

3719+ ["Try","putting","an",D.green "=","followed","by","an","expression?"

4233− ]

3720+ ]

4234− , noteForRecordIndentError

4235− ]

4236 )

3721 )

4237

3722

4238 RecordIndentExpr row col ->

3723 RecordIndentExpr row col ->

@@ -4246,48 +3731,52 @@ toRecordReport source context record startRow startCol =

4246 D.reflow $

3731 D.reflow $

4247 "I am partway through parsing a record, and I was expecting to run into an expression next:"

3732 "I am partway through parsing a record, and I was expecting to run into an expression next:"

4248 ,

3733 ,

4249− D.stack

3734+ addNoteForRecordIndentError $

4250− [ D.fillSep $

3735+ D.fillSep $

4251− ["Try","putting","something","like"

3736+ ["Try","putting","something","like"

4252− ,D.dullyellow "42","or",D.dullyellow"\"hello\"","for","now?"

3737+ ,D.dullyellow "42","or",D.dullyellow"\"hello\"","for","now?"

4253− ]

3738+ ]

4254− , noteForRecordIndentError

4255− ]

4256 )

3739 )

4257

3740

4258

3741

4259−noteForRecordError :: D.Doc

3742+addNoteForRecordError :: D.Doc -> D.Doc

4260−noteForRecordError =

3743+addNoteForRecordError normalRecommendation =

4261 D.stack $

3744 D.stack $

3745+ normalRecommendation

3746+ :

4262 [ D.toSimpleNote

3747 [ D.toSimpleNote

4263 "If you are trying to define a record across multiple lines, I recommend using this format:"

3748 "If you are trying to define a record across multiple lines, I recommend using this format:"

4264 , D.indent 4 $ D.vcat $

3749 , D.indent 4 $ D.vcat $

4265− [ "{ name = " <> D.dullyellow "\"Alice\""

3750+ [ "{ name = \"Alice\""

4266− , ", age = " <> D.dullyellow "42"

3751+ , ", age = 42"

4267− , ", height = " <> D.dullyellow "1.75"

3752+ , ", height = 1.75"

4268 , "}"

3753 , "}"

4269 ]

3754 ]

4270 , D.reflow $

3755 , D.reflow $

4271− "Notice that each line starts with some indentation. Usually two or four spaces.\

3756+ "Notice that each line starts with some indentation. Usually two or four spaces. I\

4272− \ This is the stylistic convention in the Elm ecosystem."

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."

4273 ]

3759 ]

4274

3760

4275

3761

4276−noteForRecordIndentError :: D.Doc

3762+addNoteForRecordIndentError :: D.Doc -> D.Doc

4277−noteForRecordIndentError =

3763+addNoteForRecordIndentError normalRecommendation =

4278− D.stack

3764+ D.stack $

3765+ normalRecommendation

3766+ :

4279 [ D.toSimpleNote

3767 [ D.toSimpleNote

4280 "I may be confused by indentation. For example, if you are trying to define\

3768 "I may be confused by indentation. For example, if you are trying to define\

4281 \ a record across multiple lines, I recommend using this format:"

3769 \ a record across multiple lines, I recommend using this format:"

4282 , D.indent 4 $ D.vcat $

3770 , D.indent 4 $ D.vcat $

4283− [ "{ name = " <> D.dullyellow "\"Alice\""

3771+ [ "{ name = \"Alice\""

4284− , ", age = " <> D.dullyellow "42"

3772+ , ", age = 42"

4285− , ", height = " <> D.dullyellow "1.75"

3773+ , ", height = 1.75"

4286 , "}"

3774 , "}"

4287 ]

3775 ]

4288 , D.reflow $

3776 , D.reflow $

4289− "Notice that each line starts with some indentation. Usually two or four spaces.\

3777+ "Notice that each line starts with some indentation. Usually two or four spaces. I\

4290− \ This is the stylistic convention in the Elm ecosystem!"

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."

4291 ]

3780 ]

4292

3781

4293

3782

@@ -4476,14 +3965,15 @@ toListReport source context list startRow startCol =

4476 , D.toSimpleNote

3965 , D.toSimpleNote

4477 "I recommend using the following format for lists that span multiple lines:"

3966 "I recommend using the following format for lists that span multiple lines:"

4478 , D.indent 4 $ D.vcat $

3967 , D.indent 4 $ D.vcat $

4479− [ "[ " <> D.dullyellow "\"Alice\""

3968+ [ "[ \"Alice\""

4480− , ", " <> D.dullyellow "\"Bob\""

3969+ , ", \"Bob\""

4481− , ", " <> D.dullyellow "\"Chuck\""

3970+ , ", \"Chuck\""

4482 , "]"

3971 , "]"

4483 ]

3972 ]

4484 , D.reflow $

3973 , D.reflow $

4485− "Notice that each line starts with some indentation. Usually two or four spaces.\

3974+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\

4486− \ This is the stylistic convention in the Elm ecosystem."

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."

4487 ]

3977 ]

4488 )

3978 )

4489

3979

@@ -4536,14 +4026,15 @@ toListReport source context list startRow startCol =

4536 "I may be confused by indentation. For example, if you are trying to define\

4026 "I may be confused by indentation. For example, if you are trying to define\

4537 \ a list across multiple lines, I recommend using this format:"

4027 \ a list across multiple lines, I recommend using this format:"

4538 , D.indent 4 $ D.vcat $

4028 , D.indent 4 $ D.vcat $

4539− [ "[ " <> D.dullyellow "\"Alice\""

4029+ [ "[ \"Alice\""

4540− , ", " <> D.dullyellow "\"Bob\""

4030+ , ", \"Bob\""

4541− , ", " <> D.dullyellow "\"Chuck\""

4031+ , ", \"Chuck\""

4542 , "]"

4032 , "]"

4543 ]

4033 ]

4544 , D.reflow $

4034 , D.reflow $

4545− "Notice that each line starts with some indentation. Usually two or four spaces.\

4035+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\

4546− \ This is the stylistic convention in the Elm ecosystem."

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."

4547 ]

4038 ]

4548 )

4039 )

4549

4040

@@ -4567,14 +4058,15 @@ toListReport source context list startRow startCol =

4567 "I may be confused by indentation. For example, if you are trying to define\

4058 "I may be confused by indentation. For example, if you are trying to define\

4568 \ a list across multiple lines, I recommend using this format:"

4059 \ a list across multiple lines, I recommend using this format:"

4569 , D.indent 4 $ D.vcat $

4060 , D.indent 4 $ D.vcat $

4570− [ "[ " <> D.dullyellow "\"Alice\""

4061+ [ "[ \"Alice\""

4571− , ", " <> D.dullyellow "\"Bob\""

4062+ , ", \"Bob\""

4572− , ", " <> D.dullyellow "\"Chuck\""

4063+ , ", \"Chuck\""

4573 , "]"

4064 , "]"

4574 ]

4065 ]

4575 , D.reflow $

4066 , D.reflow $

4576− "Notice that each line starts with some indentation. Usually two or four spaces.\

4067+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\

4577− \ This is the stylistic convention in the Elm ecosystem."

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."

4578 ]

4070 ]

4579 )

4071 )

4580

4072

@@ -4595,14 +4087,15 @@ toListReport source context list startRow startCol =

4595 , D.toSimpleNote

4087 , D.toSimpleNote

4596 "I recommend using the following format for lists that span multiple lines:"

4088 "I recommend using the following format for lists that span multiple lines:"

4597 , D.indent 4 $ D.vcat $

4089 , D.indent 4 $ D.vcat $

4598− [ "[ " <> D.dullyellow "\"Alice\""

4090+ [ "[ \"Alice\""

4599− , ", " <> D.dullyellow "\"Bob\""

4091+ , ", \"Bob\""

4600− , ", " <> D.dullyellow "\"Chuck\""

4092+ , ", \"Chuck\""

4601 , "]"

4093 , "]"

4602 ]

4094 ]

4603 , D.reflow $

4095 , D.reflow $

4604− "Notice that each line starts with some indentation. Usually two or four spaces.\

4096+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\

4605− \ This is the stylistic convention in the Elm ecosystem."

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."

4606 ]

4099 ]

4607 )

4100 )

4608

4101

@@ -4851,7 +4344,7 @@ toPatternReport source context pattern startRow startCol =

4851 ,"((" <> D.dullyellow "x" <> "," <> D.dullyellow "y" <> ") " <> D.cyan "as" <> D.dullyellow " point" <> ")"

4344 ,"((" <> D.dullyellow "x" <> "," <> D.dullyellow "y" <> ") " <> D.cyan "as" <> D.dullyellow " point" <> ")"

4852 ,"so","you","can","refer","to","individual","parts","of","the","tuple","with"

4345 ,"so","you","can","refer","to","individual","parts","of","the","tuple","with"

4853 ,D.dullyellow "x","and",D.dullyellow "y","or","you","refer","to","the","whole"

4346 ,D.dullyellow "x","and",D.dullyellow "y","or","you","refer","to","the","whole"

4854− ,"thing","with",D.dullyellow "point" <> "."

4347+ ,"thing","with",D.dullyellow "point."

4855 ]

4348 ]

4856 , D.reflow $

4349 , D.reflow $

4857 "So I was expecting to see a variable name after the `as` keyword here. Sometimes\

4350 "So I was expecting to see a variable name after the `as` keyword here. Sometimes\

@@ -5043,7 +4536,7 @@ toPTupleReport source context tuple startRow startCol =

5043 "I just saw an open parenthesis, but I got stuck here:"

4536 "I just saw an open parenthesis, but I got stuck here:"

5044 ,

4537 ,

5045 D.fillSep

4538 D.fillSep

5046− ["I","was","expecting","to","see","a","pattern","next."

4539+ ["I","was","expecting","so","see","a","pattern","next."

5047 ,"Maybe","it","will","end","up","being","something"

4540 ,"Maybe","it","will","end","up","being","something"

5048 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "?"

4541 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "?"

5049 ]

4542 ]

@@ -5152,7 +4645,7 @@ toPTupleReport source context tuple startRow startCol =

5152 "I just saw an open parenthesis, but then I got stuck here:"

4645 "I just saw an open parenthesis, but then I got stuck here:"

5153 ,

4646 ,

5154 D.fillSep

4647 D.fillSep

5155− ["I","was","expecting","to","see","a","pattern","next."

4648+ ["I","was","expecting","so","see","a","pattern","next."

5156 ,"Maybe","it","will","end","up","being","something"

4649 ,"Maybe","it","will","end","up","being","something"

5157 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "?"

4650 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "?"

5158 ]

4651 ]

@@ -5171,7 +4664,7 @@ toPTupleReport source context tuple startRow startCol =

5171 ,

4664 ,

5172 D.stack

4665 D.stack

5173 [ D.fillSep

4666 [ D.fillSep

5174− ["I","was","expecting","to","see","a","pattern","next."

4667+ ["I","was","expecting","so","see","a","pattern","next."

5175 ,"I","am","expecting","the","final","result","to","be","something"

4668 ,"I","am","expecting","the","final","result","to","be","something"

5176 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "."

4669 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "."

5177 ]

4670 ]

@@ -5475,64 +4968,22 @@ toTRecordReport source context record startRow startCol =

5475 \ that is a reserved word. Try using a different name!"

4968 \ that is a reserved word. Try using a different name!"

5476 )

4969 )

5477

4970

5478− Code.Other (Just ',') ->

5479− let

5480− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

5481− region = toRegion row col

5482− in

5483− Report.Report "EXTRA COMMA" region [] $

5484− Code.toSnippet source surroundings (Just region)

5485− (

5486− D.reflow $

5487− "I am partway through parsing a record type, but I got stuck here:"

5488− ,

5489− D.stack

5490− [ D.reflow $

5491− "I am seeing two commas in a row. This is the second one!"

5492− , D.reflow $

5493− "Just delete one of the commas and you should be all set!"

5494− , noteForRecordTypeError

5495− ]

5496− )

5497−

5498− Code.Close _ '}' ->

5499− let

5500− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

5501− region = toRegion row col

5502− in

5503− Report.Report "EXTRA COMMA" region [] $

5504− Code.toSnippet source surroundings (Just region)

5505− (

5506− D.reflow $

5507− "I am partway through parsing a record type, but I got stuck here:"

5508− ,

5509− D.stack

5510− [ D.reflow $

5511− "Trailing commas are not allowed in record types. Try deleting the comma that\

5512− \ appears before this closing curly brace."

5513− , noteForRecordTypeError

5514− ]

5515− )

5516−

5517 _ ->

4971 _ ->

5518 let

4972 let

5519 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

4973 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

5520 region = toRegion row col

4974 region = toRegion row col

5521 in

4975 in

5522− Report.Report "PROBLEM IN RECORD TYPE" region [] $

4976+ Report.Report "UNFINISHED RECORD TYPE" region [] $

5523 Code.toSnippet source surroundings (Just region)

4977 Code.toSnippet source surroundings (Just region)

5524 (

4978 (

5525 D.reflow $

4979 D.reflow $

5526− "I am partway through parsing a record type, but I got stuck here:"

4980+ "I am partway through parsing a record type, but I got stuck after that last comma:"

5527 ,

4981 ,

5528− D.stack

4982+ addNoteForRecordTypeError $

5529− [ D.fillSep

4983+ D.reflow $

5530− ["I","was","expecting","to","see","another","record","field","defined","next,"

4984+ "Trailing commas are not allowed in records, so I was expecting to see another\

5531− ,"so","I","am","looking","for","a","name","like"

4985+ \ record field defined next. If you are done defining the record, the fix may\

5532− ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."

4986+ \ be to delete that last comma?"

5533− ]

5534− , noteForRecordTypeError

5535− ]

5536 )

4987 )

5537

4988

5538 TRecordColon row col ->

4989 TRecordColon row col ->

@@ -5546,13 +4997,11 @@ toTRecordReport source context record startRow startCol =

5546 D.reflow $

4997 D.reflow $

5547 "I am partway through parsing a record type, but I got stuck here:"

4998 "I am partway through parsing a record type, but I got stuck here:"

5548 ,

4999 ,

5549− D.stack

5000+ addNoteForRecordTypeError $

5550− [ D.fillSep $

5001+ D.fillSep $

5551− ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"

5002+ ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"

5552− ,"a","colon","next.","So","try","putting","an",D.green ":","sign","here?"

5003+ ,"a","colon","next.","So","try","putting","an",D.green ":","sign","here?"

5553− ]

5004+ ]

5554− , noteForRecordTypeError

5555− ]

5556 )

5005 )

5557

5006

5558 TRecordType tipe row col ->

5007 TRecordType tipe row col ->

@@ -5572,54 +5021,29 @@ toTRecordReport source context record startRow startCol =

5572 D.reflow $

5021 D.reflow $

5573 "I just saw the opening curly brace of a record type, but then I got stuck here:"

5022 "I just saw the opening curly brace of a record type, but then I got stuck here:"

5574 ,

5023 ,

5575− D.stack

5024+ addNoteForRecordTypeIndentError $

5576− [ D.fillSep $

5025+ D.fillSep $

5577− ["I","am","expecting","a","record","like",D.dullyellow "{ name : String, age : Int }","here."

5026+ ["I","am","expecting","a","record","like",D.dullyellow "{ name : String, age : Int }","here."

5578− ,"Try","defining","some","fields","of","your","own?"

5027+ ,"Try","defining","some","fields","of","your","own?"

5579− ]

5028+ ]

5580− , noteForRecordTypeIndentError

5581− ]

5582 )

5029 )

5583

5030

5584 TRecordIndentEnd row col ->

5031 TRecordIndentEnd row col ->

5585− case Code.nextLineStartsWithCloseCurly source row of

5032+ let

5586− Just (curlyRow, curlyCol) ->

5033+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

5587− let

5034+ region = toRegion row col

5588− surroundings = A.Region (A.Position startRow startCol) (A.Position curlyRow curlyCol)

5035+ in

5589− region = toRegion curlyRow curlyCol

5036+ Report.Report "UNFINISHED RECORD TYPE" region [] $

5590− in

5037+ Code.toSnippet source surroundings (Just region)

5591− Report.Report "NEED MORE INDENTATION" region [] $

5038+ (

5592− Code.toSnippet source surroundings (Just region)

5039+ D.reflow $

5593− (

5040+ "I was expecting to see a closing curly brace next:"

5594− D.reflow $

5041+ ,

5595− "I was partway through parsing a record type, but I got stuck here:"

5042+ addNoteForRecordTypeIndentError $

5596− ,

5043+ D.fillSep $

5597− D.stack

5044+ ["Try","putting","an",D.green "}","and","see","if","that","helps?"

5598− [ D.reflow $

5045+ ]

5599− "I need this curly brace to be indented more. Try adding some spaces before it!"

5046+ )

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

5623

5047

5624 TRecordIndentField row col ->

5048 TRecordIndentField row col ->

5625 let

5049 let

@@ -5632,13 +5056,11 @@ toTRecordReport source context record startRow startCol =

5632 D.reflow $

5056 D.reflow $

5633 "I am partway through parsing a record type, but I got stuck after that last comma:"

5057 "I am partway through parsing a record type, but I got stuck after that last comma:"

5634 ,

5058 ,

5635− D.stack

5059+ addNoteForRecordTypeIndentError $

5636− [ D.reflow $

5060+ D.reflow $

5637− "Trailing commas are not allowed in record types, so the fix may be to\

5061+ "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\

5062+ \ delete that last comma? Or maybe you were in the middle of defining\

5639− \ an additional field?"

5063+ \ an additional field?"

5640− , noteForRecordTypeIndentError

5641− ]

5642 )

5064 )

5643

5065

5644 TRecordIndentColon row col ->

5066 TRecordIndentColon row col ->

@@ -5653,12 +5075,10 @@ toTRecordReport source context record startRow startCol =

5653 "I am partway through parsing a record type. I just saw a record\

5075 "I am partway through parsing a record type. I just saw a record\

5654 \ field, so I was expecting to see a colon next:"

5076 \ field, so I was expecting to see a colon next:"

5655 ,

5077 ,

5656− D.stack

5078+ addNoteForRecordTypeIndentError $

5657− [ D.fillSep $

5079+ D.fillSep $

5658− ["Try","putting","an",D.green ":","followed","by","a","type?"

5080+ ["Try","putting","an",D.green ":","followed","by","a","type?"

5659− ]

5081+ ]

5660− , noteForRecordTypeIndentError

5661− ]

5662 )

5082 )

5663

5083

5664 TRecordIndentType row col ->

5084 TRecordIndentType row col ->

@@ -5672,19 +5092,19 @@ toTRecordReport source context record startRow startCol =

5672 D.reflow $

5092 D.reflow $

5673 "I am partway through parsing a record type, and I was expecting to run into a type next:"

5093 "I am partway through parsing a record type, and I was expecting to run into a type next:"

5674 ,

5094 ,

5675− D.stack

5095+ addNoteForRecordTypeIndentError $

5676− [ D.fillSep $

5096+ D.fillSep $

5677− ["Try","putting","something","like"

5097+ ["Try","putting","something","like"

5678− ,D.dullyellow "Int","or",D.dullyellow "String","for","now?"

5098+ ,D.dullyellow "Int","or",D.dullyellow "String","for","now?"

5679− ]

5099+ ]

5680− , noteForRecordTypeIndentError

5681− ]

5682 )

5100 )

5683

5101

5684

5102

5685−noteForRecordTypeError :: D.Doc

5103+addNoteForRecordTypeError :: D.Doc -> D.Doc

5686−noteForRecordTypeError =

5104+addNoteForRecordTypeError normalRecommendation =

5687 D.stack $

5105 D.stack $

5106+ normalRecommendation

5107+ :

5688 [ D.toSimpleNote

5108 [ D.toSimpleNote

5689 "If you are trying to define a record type across multiple lines, I recommend using this format:"

5109 "If you are trying to define a record type across multiple lines, I recommend using this format:"

5690 , D.indent 4 $ D.vcat $

5110 , D.indent 4 $ D.vcat $

@@ -5694,14 +5114,17 @@ noteForRecordTypeError =

5694 , "}"

5114 , "}"

5695 ]

5115 ]

5696 , D.reflow $

5116 , D.reflow $

5697− "Notice that each line starts with some indentation. Usually two or four spaces.\

5117+ "Notice that each line starts with some indentation. Usually two or four spaces. I\

5698− \ This is the stylistic convention in the Elm ecosystem."

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."

5699 ]

5120 ]

5700

5121

5701

5122

5702−noteForRecordTypeIndentError :: D.Doc

5123+addNoteForRecordTypeIndentError :: D.Doc -> D.Doc

5703−noteForRecordTypeIndentError =

5124+addNoteForRecordTypeIndentError normalRecommendation =

5704 D.stack $

5125 D.stack $

5126+ normalRecommendation

5127+ :

5705 [ D.toSimpleNote

5128 [ D.toSimpleNote

5706 "I may be confused by indentation. For example, if you are trying to define\

5129 "I may be confused by indentation. For example, if you are trying to define\

5707 \ a record type across multiple lines, I recommend using this format:"

5130 \ a record type across multiple lines, I recommend using this format:"

@@ -5712,8 +5135,9 @@ noteForRecordTypeIndentError =

5712 , "}"

5135 , "}"

5713 ]

5136 ]

5714 , D.reflow $

5137 , D.reflow $

5715− "Notice that each line starts with some indentation. Usually two or four spaces.\

5138+ "Notice that each line starts with some indentation. Usually two or four spaces. I\

5716− \ This is the stylistic convention in the Elm ecosystem."

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."

5717 ]

5141 ]

5718

5142

5719

5143

@@ -5765,7 +5189,7 @@ toTTupleReport source context tuple startRow startCol =

5765 Code.toSnippet source surroundings (Just region)

5189 Code.toSnippet source surroundings (Just region)

5766 (

5190 (

5767 D.reflow $

5191 D.reflow $

5768− "I was expecting to see a closing parenthesis next, but I got stuck here:"

5192+ "I was expecting to see a closing parentheses next, but I got stuck here:"

5769 ,

5193 ,

5770 D.stack

5194 D.stack

5771 [ D.fillSep ["Try","adding","a",D.dullyellow ")","to","see","if","that","helps?"]

5195 [ D.fillSep ["Try","adding","a",D.dullyellow ")","to","see","if","that","helps?"]

compiler/src/Reporting/Error/Type.hs+23−44

@@ -231,7 +231,7 @@ toPatternReport source localizer patternRegion category tipe expected =

231 "But all the previous patterns match:"

232 [ D.link "Note"

233 "A `case` expression can only handle one type of value, so you may want to use"

234− "custom-types"

234+ "union-types"

235 "to handle “mixing” types."

236 ]

237 )

@@ -253,11 +253,11 @@ toPatternReport source localizer patternRegion category tipe expected =

253 , patternTypeComparison localizer tipe expectedType

254 (addPatternCategory ("The " <> D.ordinal index <> " pattern is trying to match") category)

255 "But all the previous patterns in the list are:"

256− [ D.link "Hint"

256+ [ D.toSimpleHint $

257− "Everything in a list must be the same type of value. This way, we never\

257+ "Everything in the list needs to be the same type of value.\

258− \ run into unexpected values partway through a List.map, List.foldl, etc. Read"

258+ \ This way you never run into unexpected values partway through.\

259− "custom-types"

259+ \ To mix different types in a single list, create a \"union type\" as\

260− "to learn how to “mix” types."

260+ \ described in: <http://guide.elm-lang.org/types/union_types.html>"

261 ]

262 )

263

@@ -431,14 +431,13 @@ problemToHint problem =

431 ]

432 ]

433

434− T.ArityMismatch x y ->

434+ T.AnythingToList ->

435− [ D.toSimpleHint $

435+ [ D.toSimpleHint "Did you forget to add [] around it?"

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."

440 ]

436 ]

441

437

438+ T.MissingArgs _ -> []

439+ T.ReturnMismatch -> []

440+

442 T.BadFlexSuper direction super _ tipe ->

441 T.BadFlexSuper direction super _ tipe ->

443 case tipe of

442 case tipe of

444 T.Lambda _ _ _ -> badFlexSuper direction super tipe

443 T.Lambda _ _ _ -> badFlexSuper direction super tipe

@@ -559,31 +558,11 @@ badFlexSuper :: T.Direction -> T.Super -> T.Type -> [D.Doc]

559badFlexSuper direction super tipe =

558badFlexSuper direction super tipe =

560 case super of

559 case super of

561 T.Comparable ->

560 T.Comparable ->

562− case tipe of

561+ [ D.toSimpleHint "Only ints, floats, chars, strings, lists, and tuples are comparable."

563− T.Record _ _ ->

562+ ]

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

584

563

585 T.Appendable ->

564 T.Appendable ->

586− [ D.toSimpleHint "I only know how to append strings and lists."

565+ [ D.toSimpleHint "Only strings and lists are appendable."

587 ]

566 ]

588

567

589 T.CompAppend ->

568 T.CompAppend ->

@@ -710,11 +689,11 @@ toExprReport source localizer exprRegion category tipe expected =

710 , "The " <> ith <> " element of this list does not match all the previous elements:"

689 , "The " <> ith <> " element of this list does not match all the previous elements:"

711 , "The " <> ith <> " element is"

690 , "The " <> ith <> " element is"

712 , "But all the previous elements in the list are:"

691 , "But all the previous elements in the list are:"

713− , [ D.link "Hint"

692+ , [ D.toSimpleHint $

714− "Everything in a list must be the same type of value. This way, we never\

693+ "Everything in the list needs to be the same type of value.\

715− \ run into unexpected values partway through a List.map, List.foldl, etc. Read"

694+ \ This way you never run into unexpected values partway through.\

716− "custom-types"

695+ \ To mix different types in a single list, create a \"union type\" as\

717− "to learn how to “mix” types."

696+ \ described in: <http://guide.elm-lang.org/types/union_types.html>"

718 ]

697 ]

719 )

698 )

720

699

@@ -761,7 +740,7 @@ toExprReport source localizer exprRegion category tipe expected =

761 , [ D.link "Hint"

740 , [ D.link "Hint"

762 "All branches in an `if` must produce the same type of values. This way, no\

741 "All branches in an `if` must produce the same type of values. This way, no\

763 \ matter which branch we take, the result is always a consistent shape. Read"

742 \ matter which branch we take, the result is always a consistent shape. Read"

764− "custom-types"

743+ "union-types"

765 "to learn how to “mix” types."

744 "to learn how to “mix” types."

766 ]

745 ]

767 )

746 )

@@ -776,7 +755,7 @@ toExprReport source localizer exprRegion category tipe expected =

776 , [ D.link "Hint"

755 , [ D.link "Hint"

777 "All branches in a `case` must produce the same type of values. This way, no\

756 "All branches in a `case` must produce the same type of values. This way, no\

778 \ matter which branch we take, the result is always a consistent shape. Read"

757 \ matter which branch we take, the result is always a consistent shape. Read"

779− "custom-types"

758+ "union-types"

780 "to learn how to “mix” types."

759 "to learn how to “mix” types."

781 ]

760 ]

782 )

761 )

@@ -1093,7 +1072,7 @@ opRightToDocs localizer category op tipe expected =

1093 ( D.reflow $ "I cannot send this through the (<|) pipe:"

1072 ( D.reflow $ "I cannot send this through the (<|) pipe:"

1094 , typeComparison localizer tipe expected

1073 , typeComparison localizer tipe expected

1095 "The argument is:"

1074 "The argument is:"

1096− "But (<|) is piping it to a function that expects:"

1075+ "But (<|) is piping it a function that expects:"

1097 []

1076 []

1098 )

1077 )

1099

1078

@@ -1104,7 +1083,7 @@ opRightToDocs localizer category op tipe expected =

1104 ( D.reflow $ "This function cannot handle the argument sent through the (|>) pipe:"

1083 ( D.reflow $ "This function cannot handle the argument sent through the (|>) pipe:"

1105 , typeComparison localizer argType expectedArgType

1084 , typeComparison localizer argType expectedArgType

1106 "The argument is:"

1085 "The argument is:"

1107− "But (|>) is piping it to a function that expects:"

1086+ "But (|>) is piping it a function that expects:"

1108 []

1087 []

1109 )

1088 )

1110

1089

compiler/src/Reporting/Render/Code.hs+26−67

@@ -7,8 +7,6 @@ module Reporting.Render.Code

7 , toPair

8 , Next(..)

9 , whatIsNext

10− , nextLineStartsWithKeyword

11− , nextLineStartsWithCloseCurly

12 )

10 )

13 where

11 where

@@ -122,7 +120,7 @@ makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end

122 spaces = replicate (fromIntegral c1 + width + 1) ' '

120 spaces = replicate (fromIntegral c1 + width + 1) ' '

123 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'

121 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'

124 in

122 in

125− Just (D.fromChars spaces <> D.red (D.fromChars zigzag))

123+ Just (D.fromChars spaces <> D.dullred (D.fromChars zigzag))

126

124

127

125

128drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc

126drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc

@@ -148,7 +146,7 @@ addLineNumber addZigZag width start end n line =

148

146

149 spacer =

147 spacer =

150 if addZigZag && start <= n && n <= end then

148 if addZigZag && start <= n && n <= end then

151− D.red ">"

149+ D.dullred ">"

152 else

150 else

153 " "

151 " "

154 in

152 in

@@ -183,8 +181,8 @@ renderPair source@(Source sourceLines) region1 region2 =

183 OneLine $

181 OneLine $

184 D.vcat

182 D.vcat

185 [ D.fromChars lineNumber <> "| " <> D.fromChars line

183 [ D.fromChars lineNumber <> "| " <> D.fromChars line

186− , D.fromChars spaces1 <> D.red (D.fromChars zigzag1) <>

184+ , D.fromChars spaces1 <> D.dullred (D.fromChars zigzag1) <>

187− D.fromChars spaces2 <> D.red (D.fromChars zigzag2)

185+ D.fromChars spaces2 <> D.dullred (D.fromChars zigzag2)

188 ]

186 ]

189

187

190 else

188 else

@@ -201,46 +199,35 @@ data Next

201 = Keyword [Char]

199 = Keyword [Char]

202 | Operator [Char]

200 | Operator [Char]

203 | Close [Char] Char

201 | Close [Char] Char

204− | Upper Char [Char]

202+ | Other

205− | Lower Char [Char]

206− | Other (Maybe Char)

207

203

208

204

209whatIsNext :: Source -> Row -> Col -> Next

205whatIsNext :: Source -> Row -> Col -> Next

210whatIsNext (Source sourceLines) row col =

206whatIsNext (Source sourceLines) row col =

211 case List.lookup row sourceLines of

207 case List.lookup row sourceLines of

212 Nothing ->

208 Nothing ->

213− Other Nothing

209+ Other

214

210

215 Just line ->

211 Just line ->

216− case drop (fromIntegral col - 1) line of

212+ let

217− [] ->

213+ chars = drop (fromIntegral col - 1) line

218− Other Nothing

214+ keywords = map Name.toChars (Set.toList reservedWords)

219−

215+ in

220− c:cs

216+ case List.find (startsWithKeyword chars) keywords of

221− | Char.isUpper c -> Upper c (takeWhile isInner cs)

217+ Just keyword ->

222− | Char.isLower c -> detectKeywords c cs

218+ Keyword keyword

223− | isSymbol c -> Operator (c : takeWhile isSymbol cs)

219+

224− | c == ')' -> Close "parenthesis" ')'

220+ Nothing ->

225− | c == ']' -> Close "square bracket" ']'

221+ case chars of

226− | c == '}' -> Close "curly brace" '}'

222+ [] ->

227− | otherwise -> Other (Just c)

223+ Other

228−

224+

229−

225+ c:cs

230−detectKeywords :: Char -> [Char] -> Next

226+ | isSymbol c -> Operator (c : takeWhile isSymbol cs)

231−detectKeywords c rest =

227+ | c == ')' -> Close "parenthesis" ')'

232− let

228+ | c == ']' -> Close "square bracket" ']'

233− cs = takeWhile isInner rest

229+ | c == '}' -> Close "curly brace" '}'

234− name = c : cs

230+ | otherwise -> Other

235− in

236− if Set.member (Name.fromChars name) reservedWords

237− then Keyword name

238− else Lower c name

239−

240−

241−isInner :: Char -> Bool

242−isInner char =

243− Char.isAlphaNum char || char == '_'

244

231

245

232

246isSymbol :: Char -> Bool

233isSymbol :: Char -> Bool

@@ -257,32 +244,4 @@ startsWithKeyword restOfLine keyword =

257 True

244 True

258

245

259 c:_ ->

246 c:_ ->

260− not (isInner c)

247+ not (Char.isAlphaNum c || c == '_')

261−

262−

263−nextLineStartsWithKeyword :: [Char] -> Source -> Row -> Maybe (Row, Col)

264−nextLineStartsWithKeyword keyword (Source sourceLines) row =

265− case List.lookup (row + 1) sourceLines of

266− Nothing ->

267− Nothing

268−

269− Just line ->

270− if startsWithKeyword (dropWhile (==' ') line) keyword then

271− Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))

272− else

273− Nothing

274−

275−

276−nextLineStartsWithCloseCurly :: Source -> Row -> Maybe (Row, Col)

277−nextLineStartsWithCloseCurly (Source sourceLines) row =

278− case List.lookup (row + 1) sourceLines of

279− Nothing ->

280− Nothing

281−

282− Just line ->

283− case dropWhile (==' ') line of

284− '}':_ ->

285− Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))

286−

287− _ ->

288− Nothing

compiler/src/Reporting/Render/Type/Localizer.hs+25−5

@@ -7,6 +7,8 @@ module Reporting.Render.Type.Localizer

7 , empty

8 , fromNames

9 , fromModule

10+ , replEmpty

11+ , replAdd

10 )

12 )

11 where

13 where

@@ -16,6 +18,7 @@ import qualified Data.Name as Name

16import qualified Data.Set as Set

18import qualified Data.Set as Set

18import qualified AST.Source as Src

20import qualified AST.Source as Src

21+import qualified Elm.Compiler.Imports as Imports

19import qualified Elm.ModuleName as ModuleName

22import qualified Elm.ModuleName as ModuleName

20import Reporting.Doc ((<>))

23import Reporting.Doc ((<>))

21import qualified Reporting.Doc as D

24import qualified Reporting.Doc as D

@@ -112,9 +115,26 @@ toExposing exposing =

112 Only (foldr addType Set.empty exposedList)

115 Only (foldr addType Set.empty exposedList)

113

116

114

117

115−addType :: Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name

118+addType :: A.Located Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name

116−addType exposed types =

119+addType (A.At _ exposed) types =

117 case exposed of

120 case exposed of

118− Src.Lower _ -> types

121+ Src.Lower _ -> types

119− Src.Upper (A.At _ name) _ -> Set.insert name types

122+ Src.Upper name _ -> Set.insert name types

120− Src.Operator _ _ -> 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+

compiler/src/Reporting/Result.hs−10

@@ -117,13 +117,3 @@ instance Monad (Result i w e) where

117 Result kb -> kb i1 w1 bad good

118 in

119 ka i w bad good1

120−

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+123−14

@@ -175,7 +175,9 @@ data Problem

175 | StringToFloat

176 | AnythingToBool

177 | AnythingFromMaybe

178− | ArityMismatch Int Int

178+ | AnythingToList

179+ | MissingArgs Int

180+ | ReturnMismatch

179 | BadFlexSuper Direction Super Name.Name Type

181 | BadFlexSuper Direction Super Name.Name Type

180 | BadRigidVar Name.Name Type

182 | BadRigidVar Name.Name Type

181 | BadRigidSuper Super Name.Name Type

183 | BadRigidSuper Super Name.Name Type

@@ -253,11 +255,7 @@ toDiff localizer ctx tipe1 tipe2 =

253 <*> toDiff localizer RT.Func b y

255 <*> toDiff localizer RT.Func b y

254 <*> sequenceA (zipWith (toDiff localizer RT.Func) cs zs)

256 <*> sequenceA (zipWith (toDiff localizer RT.Func) cs zs)

255 else

257 else

256− let f = toDoc localizer RT.Func in

258+ diffLambda localizer ctx a b cs x y zs

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

261

259

262 (Tuple a b Nothing, Tuple x y Nothing) ->

260 (Tuple a b Nothing, Tuple x y Nothing) ->

263 RT.tuple

261 RT.tuple

@@ -300,7 +298,7 @@ toDiff localizer ctx tipe1 tipe2 =

300 different

298 different

301 (toDoc localizer ctx t1)

299 (toDoc localizer ctx t1)

302 (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [toDoc localizer RT.App t2])

300 (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [toDoc localizer RT.App t2])

303− Bag.empty

301+ (Bag.one AnythingToList)

304

302

305 (Alias home1 name1 args1 t1, t2) ->

303 (Alias home1 name1 args1 t1, t2) ->

306 case diffAliasedRecord localizer t1 t2 of

304 case diffAliasedRecord localizer t1 t2 of

@@ -449,13 +447,6 @@ isSuper super tipe =

449 Appendable -> isString h n || isList h n

447 Appendable -> isString h n || isList h n

450 CompAppend -> isString h n || isList h n && isSuper Comparable (head args)

448 CompAppend -> isString h n || isList h n && isSuper Comparable (head args)

451

449

452− Tuple a b maybeC ->

453− case super of

454− Number -> False

455− Comparable -> isSuper super a && isSuper super b && maybe True (isSuper super) maybeC

456− Appendable -> False

457− CompAppend -> False

458−

459 _ ->

450 _ ->

460 False

451 False

461

452

@@ -486,6 +477,124 @@ diffAliasedRecord localizer t1 t2 =

486

477

487

478

488

479

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+

489-- RECORD DIFFS

598-- RECORD DIFFS

490

599

491

600

compiler/src/Type/Solve.hs−7

@@ -427,13 +427,6 @@ typeToVariable rank pools tipe =

427 typeToVar rank pools Map.empty tipe

428

429

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

437typeToVar :: Int -> Pools -> Map.Map Name.Name Variable -> Type -> IO Variable

430typeToVar :: Int -> Pools -> Map.Map Name.Name Variable -> Type -> IO Variable

438typeToVar rank pools aliasDict tipe =

431typeToVar rank pools aliasDict tipe =

439 let go = typeToVar rank pools aliasDict in

432 let go = typeToVar rank pools aliasDict in

compiler/src/Type/Unify.hs+10−12

@@ -103,13 +103,6 @@ instance Monad Unify where

103 in

104 ka vars ok1 err

105

106− (>>) (Unify ka) (Unify kb) =

107− Unify $ \vars ok err ->

108− let

109− ok1 vars1 _ = kb vars1 ok err

110− in

111− ka vars ok1 err

112−

113

106

114register :: IO Variable -> Unify Variable

107register :: IO Variable -> Unify Variable

115register mkVar =

108register mkVar =

@@ -219,6 +212,8 @@ unifyFlex context content otherContent =

219 Error ->

212 Error ->

220 merge context Error

213 merge context Error

221

214

215+ -- TODO see if wildcarding makes a noticable perf difference

216+

222 FlexVar maybeName ->

217 FlexVar maybeName ->

223 merge context $

218 merge context $

224 case maybeName of

219 case maybeName of

@@ -391,13 +386,13 @@ unifyFlexSuperStructure context super flatType =

391

386

392 Comparable ->

387 Comparable ->

393 do comparableOccursCheck context

388 do comparableOccursCheck context

394− unifyComparableRecursive variable

395 merge context (Structure flatType)

389 merge context (Structure flatType)

390+ unifyComparableRecursive variable

396

391

397 CompAppend ->

392 CompAppend ->

398 do comparableOccursCheck context

393 do comparableOccursCheck context

399− unifyComparableRecursive variable

400 merge context (Structure flatType)

394 merge context (Structure flatType)

395+ unifyComparableRecursive variable

401

396

402 Tuple1 a b maybeC ->

397 Tuple1 a b maybeC ->

403 case super of

398 case super of

@@ -409,12 +404,15 @@ unifyFlexSuperStructure context super flatType =

409

404

410 Comparable ->

405 Comparable ->

411 do comparableOccursCheck context

406 do comparableOccursCheck context

407+ merge context (Structure flatType)

412 unifyComparableRecursive a

408 unifyComparableRecursive a

413 unifyComparableRecursive b

409 unifyComparableRecursive b

414 case maybeC of

410 case maybeC of

415− Nothing -> return ()

411+ Nothing ->

416− Just c -> unifyComparableRecursive c

412+ return ()

417− merge context (Structure flatType)

413+

414+ Just c ->

415+ unifyComparableRecursive c

418

416

419 CompAppend ->

417 CompAppend ->

420 mismatch

418 mismatch

docs/elm.json/application.md+2−2

@@ -8,7 +8,7 @@ This is a decent baseline for pretty much any applications made with Elm. You wi

8 "source-directories": [

9 "src"

10 ],

11− "elm-version": "0.19.1",

11+ "elm-version": "0.19.0",

12 "dependencies": {

13 "direct": {

14 "elm/browser": "1.0.0",

@@ -48,7 +48,7 @@ A list of directories where Elm code lives. Most projects just use `"src"` for e

49## `"elm-version"`

51−The exact version of Elm this builds with. Should be `"0.19.1"` for most people!

51+The exact version of Elm this builds with. Should be `"0.19.0"` for most people!

53

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

50## `"license"`

52−An OSI approved SPDX code like `"BSD-3-Clause"` or `"MIT"`. These are the two most common licenses in the Elm ecosystem, and BSD-3-Clause is a good default. But you can see the full list of options [here](https://spdx.org/licenses/).

52+An OSI approved SPDX code like `"BSD-3-Clause"` or `"MIT"`. These are the two most common licenses in the Elm ecosystem, but you can see the full list of options [here](https://spdx.org/licenses/).

54

docs/upgrade-instructions/0.19.1.mddeleted−60

@@ -1,60 +0,0 @@

1−# Upgrading to 0.19.1

2−

3−**There are no language changes**, so once you swap to `"elm-version": "0.19.1"` in your `elm.json`, most users should be able to proceed without any further code changes. **You may run into a handful of bugfixes though!** These cases are outlined below!

4−

5−

6−

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−

18−

19−## Detectable Bug Fixes

20−

21−There are three known cases where code that compiled with 0.19.0 will not compile with 0.19.1 due to bug fixes:

22−

23−

24−### 1. Ambiguous Imports

25−

26−Say you have an import like this:

27−

28−```elm

29−import Html exposing (min)

30−import Regex exposing (never)

31−

32−x = min

33−y = never

34−```

35−

36−These should be reported as ambiguous usages since the names are also exposed by `Basics`, but there was a regression in 0.19.0 described [here](https://github.com/elm/compiler/issues/1945) such that they weren't caught in specific circumstances.

37−

38−The fix is to use a qualified name like `Html.min` or `Regex.never` to make it unambiguous.

39−

40−We found a couple instances of this in packages and have submitted PRs to the relevant authors in August 2019. You may run into this in your own code as well.

41−

42−For more details on why this is considered a regression, check out the details [here](https://github.com/elm/compiler/issues/1945#issuecomment-507871919) or try it in 0.18.0 to see how it worked before.

43−

44−

45−### 2. Tabs in Comments

46−

47−The 0.19.0 binaries did not catch tab characters in comments. The new parser is better at checking for tabs, so it will object when it finds these.

48−

49−Again, we found this in some packages and reached out to the relevant authors with PRs so patches would be published before the 0.19.1 release.

50−

51−

52−### 3. Port Module with no Ports

53−

54−If you have any files that start with:

55−

56−```elm

57−port module Main exposing (..)

58−```

59−

60−But they do not actually have any `port` declarations, the 0.19.1 binary will ask you to switch to a normal module declaration like `module Main exposing (..)`

elm.cabal+12−31

@@ -38,14 +38,11 @@ Executable elm

38 if flag(dev)

39 ghc-options: -O0 -Wall -Werror

40 else

41− ghc-options: -O2 -rtsopts -threaded "-with-rtsopts=-N -qg -A128m"

41+ ghc-options: -O2 -rtsopts

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/

45 Hs-Source-Dirs:

43 Hs-Source-Dirs:

46 compiler/src

44 compiler/src

47 builder/src

45 builder/src

48− terminal/impl

49 terminal/src

46 terminal/src

51 other-extensions:

48 other-extensions:

@@ -55,38 +52,24 @@ Executable elm

55 Main.hs

52 Main.hs

57 other-modules:

54 other-modules:

58− Bump

55+ Develop.StaticFiles

59− Develop

56+ Develop.StaticFiles.Build

60− Diff

61− Init

62− Install

63 Make

57 Make

64− Publish

65− Repl

67 -- terminal args

59 -- terminal args

68− Terminal

60+ Terminal.Args

69− Terminal.Chomp

61+ Terminal.Args.Chomp

70− Terminal.Error

62+ Terminal.Args.Error

71− Terminal.Helpers

63+ Terminal.Args.Helpers

72− Terminal.Internal

64+ Terminal.Args.Internal

73−

74− -- from terminal/

75− Develop.Generate.Help

76− Develop.Generate.Index

77− Develop.StaticFiles

78− Develop.StaticFiles.Build

80 -- from builder/

66 -- from builder/

81 Build

67 Build

82− BackgroundWriter

83− Deps.Bump

84− Deps.Diff

85 Deps.Registry

68 Deps.Registry

69+ Deps.Diff

86 Deps.Solver

70 Deps.Solver

87 Deps.Website

71 Deps.Website

88 File

72 File

89− Generate

90 Http

73 Http

91 Reporting

74 Reporting

92 Reporting.Exit

75 Reporting.Exit

@@ -103,14 +86,12 @@ Executable elm

103 Elm.Compiler.Type.Extract

86 Elm.Compiler.Type.Extract

104 Elm.Constraint

87 Elm.Constraint

105 Elm.Docs

88 Elm.Docs

106− Elm.Float

107 Elm.Interface

89 Elm.Interface

108 Elm.Kernel

90 Elm.Kernel

109 Elm.Licenses

91 Elm.Licenses

110 Elm.Magnitude

92 Elm.Magnitude

111 Elm.ModuleName

93 Elm.ModuleName

112 Elm.Package

94 Elm.Package

113− Elm.String

114 Elm.Version

95 Elm.Version

115

116 -- data structures

97 -- data structures

@@ -125,7 +106,6 @@ Executable elm

125 -- json

106 -- json

126 Json.Decode

107 Json.Decode

127 Json.Encode

108 Json.Encode

128− Json.String

129

109

130 -- from compiler/

110 -- from compiler/

131 AST.Canonical

111 AST.Canonical

@@ -165,11 +145,12 @@ Executable elm

165 Parse.Module

145 Parse.Module

166 Parse.Number

146 Parse.Number

167 Parse.Pattern

147 Parse.Pattern

148+ Parse.Repl

168 Parse.Shader

149 Parse.Shader

169 Parse.Space

150 Parse.Space

170− Parse.String

171 Parse.Symbol

151 Parse.Symbol

172 Parse.Type

152 Parse.Type

153+ Parse.Utf8

173 Parse.Variable

154 Parse.Variable

174 Parse.Primitives

155 Parse.Primitives

175 Reporting.Annotation

156 Reporting.Annotation

@@ -231,7 +212,7 @@ Executable elm

231 snap-core,

212 snap-core,

232 snap-server,

213 snap-server,

233 template-haskell,

214 template-haskell,

234− time >= 1.9.1,

215+ time,

235 unordered-containers,

216 unordered-containers,

236 utf8-string,

217 utf8-string,

237 vector,

218 vector,

hints/bad-recursion.mddeleted−133

@@ -1,133 +0,0 @@

1−

2−# Hints for Bad Recursion

3−

4−There are two problems that will lead you here, both of them pretty tricky:

5−

6− 1. [**No Mutation**](#no-mutation) — 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.mddeleted−98

@@ -1,98 +0,0 @@

1−# Comparing Custom Types

2−

3−The built-in comparison operators work on a fixed set of types, like `Int` and `String`. That covers a lot of cases, but what happens when you want to compare custom types?

4−

5−This page aims to catalog these scenarios and offer alternative paths that can get you unstuck.

6−

7−

8−## Wrapped Types

9−

10−It is common to try to get some extra type safety by creating really simple custom types:

11−

12−```elm

13−type Id = Id Int

14−type Age = Age Int

15−

16−type Comment = Comment String

17−type Description = Description String

18−```

19−

20−By wrapping the primitive values like this, the type system can now help you make sure that you never mix up a `Id` and an `Age`. Those are different types! This trick is extra cool because it has no runtime cost in `--optimize` mode. The compiler can just use an `Int` or `String` directly when you use that flag!

21−

22−The problem arises when you want to use a `Id` as a key in a dictionary. This is a totally reasonable thing to do, but the current version of Elm cannot handle this scenario.

23−

24−Instead of creating a `Dict Id Info` type, one thing you can do is create a custom data structure like this:

25−

26−```elm

27−module User exposing (Id, Table, empty, get, add)

28−

29−import Dict exposing (Dict)

30−

31−

32−-- USER

33−

34−type Id = Id Int

35−

36−

37−-- TABLE

38−

39−type Table info =

40− Table Int (Dict Int info)

41−

42−empty : Table info

43−empty =

44− Table 0 Dict.empty

45−

46−get : Id -> Table info -> Maybe info

47−get (Id id) (Table _ dict) =

48− Dict.get id dict

49−

50−add : info -> Table info -> (Table info, Id)

51−add info (Table nextId dict) =

52− ( Table (nextId + 1) (Dict.insert nextId info dict)

53− , Id nextId

54− )

55−```

56−

57−There are a couple nice things about this approach:

58−

59−1. The only way to get a new `User.Id` is to `add` information to a `User.Table`.

60−2. All the operations on a `User.Table` are explicit. Does it make sense to remove users? To merge two tables together? Are there any special details to consider in those cases? This will always be captured explicitly in the interface of the `User` module.

61−3. If you ever want to switch the internal representation from `Dict` to `Array` or something else, it is no problem. All the changes will be within the `User` module.

62−

63−So while this approach is not as convenient as using a `Dict` directly, it has some benefits of its own that can be helpful in some cases.

64−

65−

66−## Enumerations to Ints

67−

68−Say you need to define a `trafficLightToInt` function:

69−

70−```elm

71−type TrafficLight = Green | Yellow | Red

72−

73−trafficLightToInt : TrafficLight -> Int

74−trafficLightToInt trafficLight =

75− ???

76−```

77−

78−We have heard that some people would prefer to use a dictionary for this sort of thing. That way you do not need to write the numbers yourself, they can be generated such that you never have a typo.

79−

80−I would recommend using a `case` expression though:

81−

82−```elm

83−type TrafficLight = Green | Yellow | Red

84−

85−trafficLightToInt : TrafficLight -> Int

86−trafficLightToInt trafficLight =

87− case trafficLight of

88− Green -> 1

89− Yellow -> 2

90− Red -> 3

91−```

92−

93−This is really straight-forward while avoiding questions like “is `Green` less than or greater than `Red`?”

94−

95−

96−## Something else?

97−

98−If you have some other situation, please tell us about it [here](https://github.com/elm/error-message-catalog/issues). That is a log of error messages that can be improved, and we can use the particulars of your scenario to add more advice on this page!

hints/comparing-records.mddeleted−85

@@ -1,85 +0,0 @@

1−# Comparing Records

2−

3−The built-in comparison operators work on a fixed set of types, like `Int` and `String`. That covers a lot of cases, but what happens when you want to compare records?

4−

5−This page aims to catalog these scenarios and offer alternative paths that can get you unstuck.

6−

7−

8−## Sorting Records

9−

10−Say we want a `view` function that can show a list of students sorted by different characteristics.

11−

12−We could create something like this:

13−

14−```elm

15−import Html exposing (..)

16−

17−type alias Student =

18− { name : String

19− , age : Int

20− , gpa : Float

21− }

22−

23−type Order = Name | Age | GPA

24−

25−viewStudents : Order -> List Student -> Html msg

26−viewStudents order students =

27− let

28− orderlyStudents =

29− case order of

30− Name -> List.sortBy .name students

31− Age -> List.sortBy .age students

32− GPA -> List.sortBy .gpa students

33− in

34− ul [] (List.map viewStudent orderlyStudents)

35−

36−viewStudent : Student -> Html msg

37−viewStudent student =

38− li [] [ text student.name ]

39−```

40−

41−If you are worried about the performance of changing the order or updating information about particular students, you can start using the [`Html.Lazy`](https://package.elm-lang.org/packages/elm/html/latest/Html-Lazy) and [`Html.Keyed`](https://package.elm-lang.org/packages/elm/html/latest/Html-Keyed) modules. The updated code would look something like this:

42−

43−```elm

44−import Html exposing (..)

45−import Html.Lazy exposing (lazy)

46−import Html.Keyed as Keyed

47−

48−type Order = Name | Age | GPA

49−

50−type alias Student =

51− { name : String

52− , age : Int

53− , gpa : Float

54− }

55−

56−viewStudents : Order -> List Student -> Html msg

57−viewStudents order students =

58− let

59− orderlyStudents =

60− case order of

61− Name -> List.sortBy .name students

62− Age -> List.sortBy .age students

63− GPA -> List.sortBy .gpa students

64− in

65− Keyed.ul [] (List.map viewKeyedStudent orderlyStudents)

66−

67−viewKeyedStudent : Student -> (String, Html msg)

68−viewKeyedStudent student =

69− ( student.name, lazy viewStudent student )

70−

71−viewStudent : Student -> Html msg

72−viewStudent student =

73− li [] [ text student.name ]

74−```

75−

76−By using `Keyed.ul` we help the renderer move the DOM nodes around based on their key. This makes it much cheaper to reorder a bunch of students. And by using `lazy` we help the renderer skip a bunch of work. If the `Student` is the same as last time, the render can skip over it.

77−

78−> **Note:** Some people are skeptical of having logic like this in `view` functions, but I think the alternative (maintaining sort order in your `Model`) has some serious downsides. Say a colleague is adding a message to `Add` students, but they do not know about the sort order rules needed for presentation. Bug! So in this alternate design, you must diligently test your `update` function to make sure that no message disturbs the sort order. This is bound to lead to bugs over time!

79−>

80−> With all the optimizations possible with `Html.Lazy` and `Html.Keyed`, I would always be inclined to work on optimizing my `view` functions rather than making my `update` functions more complicated and error prone.

81−

82−

83−## Something else?

84−

85−If you have some other situation, please tell us about it [here](https://github.com/elm/error-message-catalog/issues). That is a log of error messages that can be improved, and we can use the particulars of your scenario to add more advice on this page!

hints/implicit-casts.mddeleted−50

@@ -1,50 +0,0 @@

1−

2−# Implicit Casts

3−

4−Many languages automatically convert from `Int` to `Float` when they think it is necessary. This conversion is often called an [implicit cast](https://en.wikipedia.org/wiki/Type_conversion).

5−

6−Languages that will add in implicit casts for addition include:

7−

8− - JavaScript

9− - Python

10− - Ruby

11− - C

12− - C++

13− - C#

14− - Java

15− - Scala

16−

17−These languages generally agree that an `Int` may be implicitly cast to a `Float` when necessary. So everyone is doing it, why not Elm?!

18−

19−## Type Inference + Implicit Casts

20−

21−Elm comes from the ML-family of languages. Languages in the ML-family that **never** do implicit casts include:

22−

23− - Standard ML

24− - OCaml

25− - Elm

26− - F#

27− - Haskell

28−

29−Why would so many languages from this lineage require explicit conversions though?

30−

31−Well, we have to go back to the 1970s for some background. J. Roger Hindley and Robin Milner independently discovered an algorithm that could _efficiently_ figure out the type of everything in your program without any type annotations. Type Inference! Every ML-family language has some variation of this algorithm at the center of its design.

32−

33−For decades, the problem was that nobody could figure out how to combine type inference with implicit casts AND make the resulting algorithm efficient enough for daily use. As far as I know, Scala was the first widely known language to figure out how to combine these two things! Its creator, Martin Odersky did a lot of work on combining type inference and subtyping to make this possible.

34−

35−So for any ML-family language designed before Scala, it is safe to assume that implicit conversions just was not an option. Okay, but what about Elm?! It comes after Scala, so why not do it like them?!

36−

37− 1. You pay performance cost to mix type inference and implicit conversions. At least as far as anyone knows, it defeats an optimization that is crucial to getting _reliably_ good performance. It is fine in most cases, but it can be a real issue in very large code bases.

38−

39− 2. Based on experience reports from Scala users, it seemed like the convenience was not worth the hidden cost. Yes, you can convert `n` in `(n + 1.5)` and everything is nice, but when you are in larger programs that are sparsely annotated, it can be quite difficult to figure out what is going on.

40−

41−This user data may be confounded by the fact that Scala allows quite extensive conversions, not just from `Int` to `Float`, but I think it is worth taking seriously nonetheless. So it is _possible_, but it has tradeoffs.

42−

43−

44−## Conclusion

45−

46−First, based on the landscape of design possibilities, it seems like requiring _explicit_ conversions is a pretty nice balance. We can have type inference, it can produce friendly error messages, the algorithm is snappy, and an unintended implicit cast will not flow hundreds of lines before manifesting to the user.

47−

48−Second, Elm very much favors explicit code, so this also fits in with the overall spirit of the language and libraries.

49−

50−I hope that clarifies why you have to add those `toFloat` and `round` functions! It definitely can take some getting used to, but there are tons of folks who get past that acclimation period and really love the tradeoffs!

hints/import-cycles.mddeleted−184

@@ -1,184 +0,0 @@

1−

2−# Import Cycles

3−

4−What is an import cycle? In practice you may see it if you create two modules with interrelated `User` and `Comment` types like this:

5−

6−```elm

7−module Comment exposing (..)

8−

9−import User

10−

11−type alias Comment =

12− { comment : String

13− , author : User.User

14− }

15−```

16−

17−```elm

18−module User exposing (..)

19−

20−import Comment

21−

22−type alias User =

23− { name : String

24− , comments : List Comment.Comment

25− }

26−```

27−

28−Notice that to compile `Comment` we need to `import User`. And notice that to compile `User` we need to `import Comment`. We need both to compile either!

29−

30−Now this is *possible* if the compiler figures out any module cycles and puts them all in one big file to compile them together. That seems fine in our small example, but imagine we have a cycle of 20 modules. If you change *one* of them, you must now recompile *all* of them. In a large code base, this causes extremely long compile times. It is also very hard to disentangle them in practice, so you just end up with slow builds. That is your life now.

31−

32−The thing is that you can always write the code *without* cycles by shuffling declarations around, and the resulting code is often much clearer.

33−

34−

35−# How to Break Cycles

36−

37−There are quite a few ways to break our `Comment` and `User` cycle from above, so let’s go through four useful strategies. The first one is by far the most common solution!

38−

39−

40−## 1. Combine the Modules

41−

42−One approach is to just combine the two modules. If we check out the resulting code, we have actually revealed a problem in how we are representing our data:

43−

44−```elm

45−module BadCombination1 exposing (..)

46−

47−type alias Comment =

48− { comment : String

49− , author : User

50− }

51−

52−type alias User =

53− { name : String

54− , comments : List Comment

55− }

56−```

57−

58−Notice that the `Comment` type alias is defined in terms of the `User` type alias and vice versa. Having recursive type aliases like this does not work! That problem is described in depth [here](recursive-alias.md), but the quick takeaway is that one `type alias` needs to become a `type` to break the recursion. So let’s try again:

59−

60−```elm

61−module BadCombination2 exposing (..)

62−

63−type alias Comment =

64− { comment : String

65− , author : User

66− }

67−

68−type alias User =

69− { name : String

70− , comments : AllUserComments

71− }

72−

73−type AllUserComments = AllUserComments (List Comment)

74−```

75−

76−Okay, now we have broken the recursion, but we need to ask ourselves, how are we going to actually instantiate these `Comment` and `User` types that we have described. A `Comment` will always have an author, and that `User` will always refer back to the `Comment`. So we seem to want cyclic data here. If we were in JavaScript we might instantiate all the comments in one pass, and then go back through and mutate the users to point to all the relevant comments. In other words, we need *mutation* to create this cyclic data!

77−

78−All values are immutable in Elm, so we need to use a more functional strategy. One common approach is to use unique identifiers. Instead of referring directly to “the user object” we can refer to a user ID:

79−

80−```elm

81−module GoodCombination exposing (..)

82−

83−import Dict

84−

85−type alias Comment =

86− { comment : String

87− , author : UserId

88− }

89−

90−type alias UserId = String

91−

92−type alias AllComments =

93− Dict.Dict UserId (List Comment)

94−```

95−

96−Now in this world, we do not even have cycles in our types anymore! That means we can actually break these out into separate modules again:

97−

98−```elm

99−module Comment exposing (..)

100−

101−import Dict

102−import User

103−

104−type alias Comment =

105− { comment : String

106− , author : User.Id

107− }

108−

109−type alias AllComments =

110− Dict.Dict User.Id (List Comment)

111−```

112−

113−```elm

114−module User exposing (..)

115−

116−type alias Id = String

117−```

118−

119−So now we are back to the two modules we wanted, but we have data structures that are going to work much better in a functional language like Elm! **This is the common approach, and it is what you hope will happen!**

120−

121−

122−## 2. Make a New Module

123−

124−Now say there are actually a ton of functions and values in the `Comment` and `User` modules. Combining them into one does not seem like a good strategy. Instead you can create a *third* module that just has the shared types and functions. Let’s pretend we call that third module `GoodCombination`. So rather than having `Comment` and `User` depend on each other, they now both depend on `GoodCombination`. We broke our cycle!

125−

126−**This strategy is less common.** You generally want to keep the core `type` of a module with all the functions that act upon it directly, so separating a `type` from everything else is a bad sign. So maybe there is a `User` module that contains a bunch of helper functions, but you *use* all those helper functions in a bunch of other modules that interact with users in various ways. In that scenario, it is still more sophisticated than “just throw the types in a module together” and hope it turns out alright.

127−

128−

129−## 3. Use Type Variables

130−

131−Another way to avoid module cycles is to be more generic in how you represent your data:

132−

133−```elm

134−module Comment exposing (..)

135−

136−type alias Comment author =

137− { comment : String

138− , author : author

139− }

140−```

141−

142−```elm

143−module User exposing (..)

144−

145−type alias User comment =

146− { name : String

147− , comments : List comment

148− }

149−```

150−

151−Notice that `Comment` and `User` no longer need to import each other! Instead, whenever we use these modules, we need to fill in the type variable. So we may import both `Comment` and `User` and try to combine them into a `Comment (User (Comment (User ...)))`. Gah, we ran into the recursive type alias thing again!

152−

153−So this strategy fails pretty badly with our particular example. The code is more complicated and it still does not work! So **this strategy is rarely useful**, but when it works, it can simplify things quite a lot.

154−

155−

156−## 4. Hiding Implementation Details in Packages

157−

158−This gets a little bit trickier when you are creating a package like `elm-lang/parser` which is built around the `Parser` type.

159−

160−That package has a couple exposed modules: `Parser`, `Parser.LanguageKit`, and `Parser.LowLevel`. All of these modules want access to the internal details of the `Parser` type, but we do not want to ever expose those internal details to the *users* of this package. So where should the `Parser` type live?!

161−

162−Usually you know which module should expose the type for the best public API. In this case, it makes sense for it to live in the `Parser` module. The way to manage this is to create a `Parser.Internal` module with a definition like:

163−

164−```elm

165−module Parser.Internal exposing (..)

166−

167−type Parser a =

168− Parser ...

169−```

170−

171−Now we can `import Parser.Internal` and use it in any of the modules in our package. The trick is that we never expose the `Parser.Internal` module to the *users* of our package. We can see what is inside, but they cannot! Then in the `Parser` module we can say:

172−

173−```elm

174−module Parser exposing (..)

175−

176−import Parser.Internal as Internal

177−

178−type alias Parser a =

179− Internal.Parser a

180−```

181−

182−So now folks see a `Parser` type exposed by the `Parser` module, and it is the one that is used throughout all the modules in the package. Do not screw up your data representation to avoid this trick! I think we can improve how this appears in documentation, but overall this is the best way to go.

183−

184−Now again, this strategy is particularly useful in packages. It is not as worthwhile in application code.

hints/imports.mddeleted−126

@@ -1,126 +0,0 @@

1−

2−# Hints for Imports

3−

4−When getting started with Elm, it is pretty common to have questions about how the `import` declarations work exactly. These questions usually arise when you start playing with the `Html` library so we will focus on that.

5−

6−

7−

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−

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−

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−

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−

100−

101−## Default Imports

102−

103−We just learned all the variations of the `import` syntax in Elm. You will use some version of that syntax to `import` any module you ever write.

104−

105−It would be the best policy to make it so every module in the whole ecosystem works this way. We thought so in the past at least, but there are some modules that are so commonly used that the Elm compiler automatically adds the imports to every file. These default imports include:

106−

107−```elm

108−import Basics exposing (..)

109−import List exposing (List, (::))

110−import Maybe exposing (Maybe(..))

111−import Result exposing (Result(..))

112−import String

113−import Tuple

114−

115−import Debug

116−

117−import Platform exposing (Program)

118−import Platform.Cmd as Cmd exposing (Cmd)

119−import Platform.Sub as Sub exposing (Sub)

120−```

121−

122−You can think of these imports being at the top of any module you write.

123−

124−One could argue that `Maybe` is so fundamental to how we handle errors in Elm code that it is *basically* part of the language. One could also argue that it is extraordinarily annoying to have to import `Maybe` once you get past your first couple weeks with Elm. Either way, we know that default imports are not ideal in some sense, so we have tried to keep the default imports as minimal as possible.

125−

126−> **Note:** Elm performs dead code elimination, so if you do not use something from a module, it is not included in the generated code. So if you `import` a module with hundreds of functions, you do not need to worry about the size of your assets. You will only get what you use!

hints/infinite-type.mddeleted−42

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

1−

2−# Hints for Infinite Types

3−

4−Infinite types are probably the trickiest kind of bugs to track down. **Writing down type annotations is usually the fastest way to figure them out.** Let's work through an example to get a feel for how these errors usually work though!

5−

6−

7−## Example

8−

9−A common way to get an infinite type error is very small typos. For example, do you see the problem in the following code?

10−

11−```elm

12−incrementNumbers list =

13− List.map incrementNumbers list

14−

15−incrementNumber n =

16− n + 1

17−```

18−

19−The issue is that `incrementNumbers` calls itself, not the `incrementNumber` function defined below. So there is an extra `s` in this program! Let's focus on that:

20−

21−```elm

22−incrementNumbers list =

23− List.map incrementNumbers list -- BUG extra `s` makes this self-recursive

24−```

25−

26−Now the compiler does not know that anything is wrong yet. It just tries to figure out the types like normal. It knows that `incrementNumbers` is a function. The definition uses `List.map` so we can deduce that `list : List t1` and the result of this function call should be some other `List t2`. This also means that `incrementNumbers : List t1 -> List t2`.

27−

28−The issue is that `List.map` uses `incrementNumbers` on `list`! That means that each element of `list` (which has type `t1`) must be fed into `incrementNumbers` (which takes `List t1`)

29−

30−That means that `t1 = List t1`, which is an infinite type! If we start expanding this, we get `List (List (List (List (List ...))))` out to infinity!

31−

32−The point is mainly that we are in a confusing situation. The types are confusing. This explanation is confusing. The compiler is confused. It is a bad time. But luckily, the more type annotations you add, the better chance there is that you and the compiler can figure things out! So say we change our definition to:

33−

34−```elm

35−incrementNumbers : List Int -> List Int

36−incrementNumbers list =

37− List.map incrementNumbers list -- STILL HAS BUG

38−```

39−

40−Now we are going to get a pretty normal type error. Hey, you said that each element in the `list` is an `Int` but I cannot feed that into a `List Int -> List Int` function! Something like that.

41−

42−In summary, the root issue is often some small typo, and the best way out is to start adding type annotations on everything!

hints/init.mddeleted−55

@@ -1,55 +0,0 @@

1−

2−# Creating an Elm project

3−

4−The main goal of `elm init` is to get you to this page!

5−

6−It just creates an `elm.json` file and a `src/` directory for your code.

7−

8−

9−## What is `elm.json`?

10−

11−This file describes your project. It lists all of the packages you depend upon, so it will say the particular version of [`elm/core`](https://package.elm-lang.org/packages/elm/core/latest/) and [`elm/html`](https://package.elm-lang.org/packages/elm/html/latest/) that you are using. It makes builds reproducible! You can read a bit more about it [here](https://github.com/elm/compiler/blob/master/docs/elm.json/application.md).

12−

13−You should generally not edit it by hand. It is better to add new dependencies with commands like `elm install elm/http` or `elm install elm/json`.

14−

15−

16−## What goes in `src/`?

17−

18−This is where all of your Elm files live. It is best to start with a file called `src/Main.elm`. As you work through [the official guide](https://guide.elm-lang.org/), you can put the code examples in that `src/Main.elm` file.

19−

20−

21−## How do I compile it?

22−

23−Run `elm reactor` in your project. Now you can go to [`http://localhost:8000`](http://localhost:8000) and browse through all the files in your project. If you navigate to `.elm` files, it will compile them for you!

24−

25−If you want to do things more manually, you can run `elm make src/Main.elm` and it will produce an `index.html` file that you can look at in your browser.

26−

27−

28−## How do I structure my directories?

29−

30−Many folks get anxious about their project structure. “If I get it wrong, I am doomed!” This anxiety makes sense in languages where refactoring is risky, but Elm is not one of those languages!

31−

32−So we recommend that newcomers staying in one file until you get into the 600 to 1000 range. Push out of your comfort zone. Having the experience of being fine in large files will help you understand the boundaries in Elm, rather than just defaulting to the boundaries you learned in another language.

33−

34−The talk [The Life of a File](https://youtu.be/XpDsk374LDE) gets into this a lot more. The advice about building modules around a specific [custom type](https://guide.elm-lang.org/types/custom_types.html) is particularly important! You will see that emphasized a lot as you work through the official guide.

35−

36−

37−## How do I write tests?

38−

39−Elm will catch a bunch of errors statically, and I think it is worth skipping tests at first to get a feeling for when tests will actually help you _in Elm_.

40−

41−From there, we have a great testing package called [`elm-explorations/test`](https://github.com/elm-explorations/test) that can help you out! It is particularly helpful for teams working on a large codebase. When you are editing code you have never seen before, tests can capture additional details and constraints that are not otherwise apparent!

42−

43−

44−## How do I start fancier projects?

45−

46−I wanted `elm init` to generate as little code as possible. It is mainly meant to get you to this page! If you would like a more elaborate starting point, I recommend starting projects with commands like these:

47−

48−```bash

49−git clone https://github.com/evancz/elm-todomvc.git

50−git clone https://github.com/rtfeldman/elm-spa-example.git

51−```

52−

53−The idea is that Elm projects should be so simple that nobody needs a tool to generate a bunch of stuff. This also captures the fact that project structure _should_ evolve organically as your application develops, never ending up exactly the same as other projects.

54−

55−But if you have something particular you want, I recommend creating your own starter recipe and using `git clone` when you start new projects. That way (1) you can get exactly what you want and (2) we do not end up with a complex `elm init` that ends up being confusing for beginners!

hints/missing-patterns.mddeleted−139

@@ -1,139 +0,0 @@

1−

2−# Hints for Missing Patterns

3−

4−Elm checks to make sure that all possible inputs to a function or `case` are handled. This gives us the guarantee that no Elm code is ever going to crash because data had an unexpected shape.

5−

6−There are a couple techniques for making this work for you in every scenario.

7−

8−

9−## The danger of wildcard patterns

10−

11−A common scenario is that you want to add a tag to a custom type that is used in a bunch of places. For example, maybe you are working different variations of users in a chat room:

12−

13−```elm

14−type User

15− = Regular String Int

16− | Anonymous

17−

18−toName : User -> String

19−toName user =

20− case user of

21− Regular name _ ->

22− name

23−

24− _ ->

25− "anonymous"

26−```

27−

28−Notice the wildcard pattern in `toName`. This will hurt us! Say we add a `Visitor String` variant to `User` at some point. Now we have a bug that visitor names are reported as `"anonymous"`, and the compiler cannot help us!

29−

30−So instead, it is better to explicitly list all possible variants, like this:

31−

32−```elm

33−type User

34− = Regular String Int

35− | Visitor String

36− | Anonymous

37−

38−toName : User -> String

39−toName user =

40− case user of

41− Regular name _ ->

42− name

43−

44− Anonymous ->

45− "anonymous"

46−```

47−

48−Now the compiler will say "hey, what should `toName` do when it sees a `Visitor`?" This is a tiny bit of extra work, but it is very worth it!

49−

50−

51−## I want to go fast!

52−

53−Imagine that the `User` type appears in 20 or 30 functions across your project. When we add a `Visitor` variant, the compiler points out all the places that need to be updated. That is very convenient, but in a big project, maybe you want to get through it extra quickly.

54−

55−In that case, it can be helpful to use [`Debug.todo`](https://package.elm-lang.org/packages/elm-lang/core/latest/Debug#todo) to leave some code incomplete:

56−

57−```elm

58−type User

59− = Regular String Int

60− | Visitor String

61− | Anonymous

62−

63−toName : User -> String

64−toName user =

65− case user of

66− Regular name _ ->

67− name

68−

69− Visitor _ ->

70− Debug.todo "give the visitor name"

71−

72− Anonymous ->

73− "anonymous"

74−

75−-- and maybe a bunch of other things

76−```

77−

78−In this case it is easier to just write the implementation, but the point is that on more complex functions, you can put things off a bit.

79−

80−The Elm compiler is actually aware of `Debug.todo` so when it sees it in a `case` like this, it will crash with a bunch of helpful information. It will tell you:

81−

82− 1. The name of the module that contains the code.

83− 2. The line numbers of the `case` containing the TODO.

84− 3. The particular value that led to this TODO.

85−

86−From that information you have a pretty good idea of what went wrong and can go fix it.

87−

88−I tend to use `Debug.todo` as the message when my goal is to go quick because it makes it easy to go and find all remaining todos in my code before a release.

89−

90−

91−## A list that definitely is not empty

92−

93−This can come up from time to time, but Elm **will not** let you write code like this:

94−

95−```elm

96−last : List a -> a

97−last list =

98− case list of

99− [x] ->

100− x

101−

102− _ :: rest ->

103− last rest

104−```

105−

106−This is no good. It does not handle the empty list. There are two ways to handle this. One is to make the function return a `Maybe` like this:

107−

108−```elm

109−last : List a -> Maybe a

110−last list =

111− case list of

112− [] ->

113− Nothing

114−

115− [x] ->

116− Just x

117−

118− _ :: rest ->

119− last rest

120−```

121−

122−This is nice because it lets users know that there might be a failure, so they can recover from it however they want.

123−

124−The other option is to “unroll the list” one level to ensure that no one can ever provide an empty list in the first place:

125−

126−```elm

127−last : a -> List a -> a

128−last first rest =

129− case rest of

130− [] ->

131− first

132−

133− newFirst :: newRest ->

134− last newFirst newRest

135−```

136−

137−By demanding the first element of the list as an argument, it becomes impossible to call this function if you have an empty list!

138−

139−This “unroll the list” trick is quite useful. I recommend using it directly, not through some external library. It is nothing special. Just a useful idea!

hints/optimize.mddeleted−59

@@ -1,59 +0,0 @@

1−

2−# How to optimize Elm code

3−

4−When you are serving a website, there are two kinds of optimizations you want to do:

5−

6−1. **Asset Size** — 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.mddeleted−32

@@ -1,32 +0,0 @@

1−

2−# No Ports in Packages

3−

4−The package ecosystem is one of the most important parts of Elm. Right now, our ecosystem has some compelling benefits:

5−

6− - There are many obvious default packages that work well.

7− - Adding dependencies cannot introduce runtime exceptions.

8− - Patch changes cannot lead to surprise build failures.

9−

10−These are really important factors if you want to *quickly* create *reliable* applications. The Elm community thinks this is valuable.

11−

12−Other communities think that the *number* of packages is a better measure of ecosystem health. That is a fine metric to use, but it is not the one we use for Elm. We would rather have 50 great packages than 100k packages of wildly varying quality.

13−

14−

15−## So what about ports?

16−

17−Imagine you install a new package that claims to support `localStorage`. You get it set up, working through any compile errors. You run it, but it does not seem to work! After trying to figure it out for hours, you realize there is some poorly documented `port` to hook up...

18−

19−Okay, now you need to hook up some JavaScript code. Is that JS file in the Elm package? Or is it on `npm`? Wait, what version on `npm` though? And is this patch version going to work as well? Also, how does this file fit into my build process? And assuming we get through all that, maybe the `port` has the same name as one of the ports in your project. Or it clashes with a `port` name in another package.

20−

21−**Suddenly adding dependencies is much more complicated and risky!** An experienced developer would always check for ports up front, spending a bunch of time manually classifying unacceptable packages. Most people would not know to do that and learn all the pitfalls through personal experience, ultimately spending even *more* time than the person who defensively checks to avoid these issues.

22−

23−So “ports in packages” would impose an enormous cost on application developers, and in the end, we would have a less reliable package ecosystem overall.

24−

25−

26−## Conclusion

27−

28−Our wager with the Elm package ecosystem is that it is better to get a package *right* than to get it *right now*. So while we could use “ports in packages” as a way to get twenty `localStorage` packages of varying quality *right now*, we are choosing not to go that route. Instead we ask that developers use ports directly in their application code, getting the same result a different way.

29−

30−Now this may not be the right choice for your particular project, and that is okay! We will be expanding our core libraries over time, as explained [here](https://github.com/elm-lang/projects/blob/master/roadmap.md#where-is-the-localstorage-package), and we hope you will circle back later to see if Elm has grown into a better fit!

31−

32−If you have more questions about this choice or what it means for your application, please come ask in [the Elm slack](http://elmlang.herokuapp.com/). Folks are friendly and happy to help out! Chances are that a `port` in your application will work great for your case once you learn more about how they are meant to be used.

hints/recursive-alias.mddeleted−162

@@ -1,162 +0,0 @@

1−

2−# Hints for Recursive Type Aliases

3−

4−At the root of this issue is the distinction between a `type` and a `type alias`.

5−

6−

7−## What is a type alias?

8−

9−When you create a type alias, you are just creating a shorthand to refer to an existing type. So when you say the following:

10−

11−```elm

12−type alias Time = Float

13−

14−type alias Degree = Float

15−

16−type alias Weight = Float

17−```

18−

19−You have not created any *new* types, you just made some alternate names for `Float`. You can write down things like this and it'll work fine:

20−

21−```elm

22−add : Time -> Degree -> Weight

23−add time degree =

24− time + degree

25−```

26−

27−This is kind of a weird way to use type aliases though. The typical usage would be for records, where you do not want to write out the whole thing every time. Stuff like this:

28−

29−```elm

30−type alias Person =

31− { name : String

32− , age : Int

33− , height : Float

34− }

35−```

36−

37−It is much easier to write down `Person` in a type, and then it will just expand out to the underlying type when the compiler checks the program.

38−

39−

40−## Recursive type aliases?

41−

42−Okay, so let's say you have some type that may contain itself. In Elm, a common example of this is a comment that might have subcomments:

43−

44−```elm

45−type alias Comment =

46− { message : String

47− , upvotes : Int

48− , downvotes : Int

49− , responses : List Comment

50− }

51−```

52−

53−Now remember that type *aliases* are just alternate names for the real type. So to make `Comment` into a concrete type, the compiler would start expanding it out.

54−

55−```elm

56− { message : String

57− , upvotes : Int

58− , downvotes : Int

59− , responses :

60− List

61− { message : String

62− , upvotes : Int

63− , downvotes : Int

64− , responses :

65− List

66− { message : String

67− , upvotes : Int

68− , downvotes : Int

69− , responses : List ...

70− }

71− }

72− }

73−```

74−

75−The compiler cannot deal with values like this. It would just keep expanding forever.

76−

77−

78−## Recursive types!

79−

80−In cases where you want a recursive type, you need to actually create a brand new type. This is what the `type` keyword is for. A simple example of this can be seen when defining a linked list:

81−

82−```elm

83−type List

84− = Empty

85− | Node Int List

86−```

87−

88−No matter what, the type of `Node n xs` is going to be `List`. There is no expansion to be done. This means you can represent recursive structures with types that do not explode into infinity.

89−

90−So let's return to wanting to represent a `Comment` that may have responses. There are a couple ways to do this:

91−

92−

93−### Obvious, but kind of annoying

94−

95−```elm

96−type Comment =

97− Comment

98− { message : String

99− , upvotes : Int

100− , downvotes : Int

101− , responses : List Comment

102− }

103−```

104−

105−Now let's say you want to register an upvote on a comment:

106−

107−```elm

108−upvote : Comment -> Comment

109−upvote (Comment comment) =

110− Comment { comment | upvotes = 1 + comment.upvotes }

111−```

112−

113−It is kind of annoying that we now have to unwrap and wrap the record to do anything with it.

114−

115−

116−### Less obvious, but nicer

117−

118−```elm

119−type alias Comment =

120− { message : String

121− , upvotes : Int

122− , downvotes : Int

123− , responses : Responses

124− }

125−

126−type Responses = Responses (List Comment)

127−```

128−

129−In this world, we introduce the `Responses` type to capture the recursion, but `Comment` is still an alias for a record. This means the `upvote` function looks nice again:

130−

131−```elm

132−upvote : Comment -> Comment

133−upvote comment =

134− { comment | upvotes = 1 + comment.upvotes }

135−```

136−

137−So rather than having to unwrap a `Comment` to do *anything* to it, you only have to do some unwrapping in the cases where you are doing something recursive. In practice, this means you will do less unwrapping which is nice.

138−

139−

140−## Mutually recursive type aliases

141−

142−It is also possible to build type aliases that are *mutually* recursive. That might be something like this:

143−

144−```elm

145−type alias Comment =

146− { message : String

147− , upvotes : Int

148− , downvotes : Int

149− , responses : Responses

150− }

151−

152−type alias Responses =

153− { sortBy : SortBy

154− , responses : List Comment

155− }

156−

157−type SortBy = Time | Score | MostResponses

158−```

159−

160−When you try to expand `Comment` you have to expand `Responses` which needs to expand `Comment` which needs to expand `Responses`, etc.

161−

162−So this is just a fancy case of a self-recursive type alias. The solution is the same. Somewhere in that cycle, you need to define an actual `type` to end the infinite expansion.

hints/repl.mddeleted−73

@@ -1,73 +0,0 @@

1−

2−# REPL

3−

4−The REPL lets you interact with Elm values and functions in your terminal.

5−

6−

7−## Use

8−

9−You can type in expressions, definitions, custom types, and module imports using normal Elm syntax.

10−

11−```elm

12−> 1 + 1

13−2 : number

14−

15−> "hello" ++ "world"

16−"helloworld" : String

17−```

18−

19−The same can be done with definitions and custom types:

20−

21−```elm

22−> fortyTwo = 42

23−42 : number

24−

25−> increment n = n + 1

26−<function> : number -> number

27−

28−> increment 41

29−42 : number

30−

31−> factorial n =

32−| if n < 1 then

33−| 1

34−| else

35−| n * factorial (n-1)

36−|

37−<function> : number -> number

38−

39−> factorial 5

40−120 : number

41−

42−> type User

43−| = Regular String

44−| | Visitor String

45−|

46−

47−> case Regular "Tom" of

48−| Regular name -> "Hey again!"

49−| Visitor name -> "Nice to meet you!"

50−|

51−"Hey again!" : String

52−```

53−

54−When you run `elm repl` in a project with an [`elm.json`](https://github.com/elm/compiler/blob/master/docs/elm.json/application.md) file, you can import any module available in the project. So if your project has an `elm/html` dependency, you could say:

55−

56−```elm

57−> import Html exposing (Html)

58−

59−> Html.text "hello"

60−<internals> : Html msg

61−

62−> Html.text

63−<function> : String -> Html msg

64−```

65−

66−If you create a module in your project named `MyThing` in your project, you can say `import MyThing` in the REPL as well. Any module that is accessible in your project should be accessible in the REPL.

67−

68−

69−## Exit

70−

71−To exit the REPL, you can type `:exit`.

72−

73−You can also press `ctrl-d` or `ctrl-c` on some platforms.

hints/shadowing.mddeleted−70

@@ -1,70 +0,0 @@

1−

2−# Variable Shadowing

3−

4−Variable shadowing is when you define the same variable name twice in an ambiguous way. Here is a pretty reasonable use of shadowing:

5−

6−```elm

7−viewName : Maybe String -> Html msg

8−viewName name =

9− case name of

10− Nothing ->

11− ...

12−

13− Just name ->

14− ...

15−```

16−

17−I define a `name` with type `Maybe String` and then in that second branch, I define a `name` that is a `String`. Now that there are two `name` values, it is not 100% obvious which one you want in that second branch.

18−

19−Most linters produce warnings on variable shadowing, so Elm makes “best practices” the default. Just rename the first one to `maybeName` and move on.

20−

21−This choice is relatively uncommon in programming languages though, so I want to provide the reasoning behind it.

22−

23−

24−## The Cost of Shadowing

25−

26−The code snippet from above is the best case scenario for variable shadowing. It is pretty clear really. But that is because it is a fake example. It does not even compile.

27−

28−In a large module that is evolving over time, this is going to cause bugs in a very predictable way. You will have two definitions, separated by hundreds of lines. For example:

29−

30−```elm

31−name : String

32−name =

33− "Tom"

34−

35−-- hundreds of lines

36−

37−viewName : String -> Html msg

38−viewName name =

39− ... name ... name ... name ...

40−```

41−

42−Okay, so the `viewName` function has an argument `name` and it uses it three times. Maybe the `viewName` function is 50 lines long in total, so those uses are not totally easy to see. This is fine so far, but say your colleague comes along five months later and wants to support first and last names. They refactor the code like this:

43−

44−```elm

45−viewName : String -> String -> Html msg

46−viewName firstName lastName =

47− ... name ... name ... name ...

48−```

49−

50−The code compiles, but it does not work as intended. They forgot to change all the uses of `name`, and because it shadows the top-level `name` value, it always shows up as `"Tom"`. It is a simple mistake, but it is always the last thing I think of.

51−

52−> Is the data being fetched properly? Let me log all of the JSON requests. Maybe the JSON decoders are messed up? Hmm. Maybe someone is transforming the name in a bad way at some point? Let me check my `update` code.

53−

54−Basically, a bunch of time gets wasted on something that could easily be detected by the compiler. But this bug is rare, right?

55−

56−

57−## Aggregate Cost

58−

59−Thinking of a unique and helpful name takes some extra time. Maybe 30 seconds. But it means that:

60−

61− 1. Your code is easier to read and understand later on. So you spend 30 seconds once `O(1)` rather than spending 10 seconds each time someone reads that code in the future `O(n)`.

62−

63− 2. The tricky shadowing bug described above is impossible. Say there is a 5% chance that any given edit produces a shadowing bug, and that resolving that shadowing bug takes one hour. That means the expected time for each edit increases by three minutes.

64−

65−If you are still skeptical, I encourage you can play around with the number of edits, time costs, and probabilities here. When shadowing is not allowed, the resulting overhead for the entire lifetime of the code is the 30 seconds it takes to pick a better name, so that is what you need to beat!

66−

67−

68−## Summary

69−

70−Without shadowing, the code easier to read and folks spend less time on pointless debugging. The net outcome is that folks have more time to make something wonderful with Elm!

hints/tuples.mddeleted−19

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

1−

2−# From Tuples to Records

3−

4−The largest tuple possible in Elm has three entries. Once you get to four, it is best to make a record with named entries.

5−

6−For example, it is _conceivable_ to represent a rectangle as four numbers like `(10,10,100,100)` but it would be more self-documenting to use a record like this:

7−

8−```elm

9−type alias Rectangle =

10− { x : Float

11− , y : Float

12− , width : Float

13− , height : Float

14− }

15−```

16−

17−Now it is clear that the dimensions should be `Float` values. It is also clear that we are not using the convention of specifying the top-left and bottom-right corners. It could be clearer about whether the `x` and `y` is the point in the top-left or in the middle though!

18−

19−Anyway, using records like this also gives you access to syntax like `rect.x`, `.x`, and `{ rect | x = 40 }`. It is not clear how to design features like that for arbitrarily sized tuples, so we did not. We already have a way, and it is more self-documenting!

hints/type-annotations.mddeleted−60

@@ -1,60 +0,0 @@

1−

2−# Hints for Type Annotation Problems

3−

4−At the root of this kind of issue is always the fact that a type annotation in your code does not match the corresponding definition. Now that may mean that the type annotation is "wrong" or it may mean that the definition is "wrong". The compiler cannot figure out your intent, only that there is some mismatch.

5−

6−This document is going to outline the various things that can go wrong and show some examples.

7−

8−

9−## Annotation vs. Definition

10−

11−The most common issue is with user-defined type variables that are too general. So let's say you have defined a function like this:

12−

13−```elm

14−addPair : (a, a) -> a

15−addPair (x, y) =

16− x + y

17−```

18−

19−The issue is that the type annotation is saying "I will accept a tuple containing literally *anything*" but the definition is using `(+)` which requires things to be numbers. So the compiler is going to infer that the true type of the definition is this:

20−

21−```elm

22−addPair : (number, number) -> number

23−```

24−

25−So you will probably see an error saying "I cannot match `a` with `number`" which is essentially saying, you are trying to provide a type annotation that is **too general**. You are saying `addPair` accepts anything, but in fact, it can only handle numbers.

26−

27−In cases like this, you want to go with whatever the compiler inferred. It is good at figuring this kind of stuff out ;)

28−

29−

30−## Annotation vs. Itself

31−

32−It is also possible to have a type annotation that clashes with itself. This is probably more rare, but someone will run into it eventually. Let's use another version of `addPair` with problems:

33−

34−```elm

35−addPair : (Int, Int) -> number

36−addPair (x, y) =

37− x + y

38−```

39−

40−In this case the annotation says we should get a `number` out, but because we were specific about the inputs being `Int`, the output should also be an `Int`.

41−

42−

43−## Annotation vs. Internal Annotation

44−

45−A quite tricky case is when an outer type annotation clashes with an inner type annotation. Here is an example of this:

46−

47−```elm

48−filter : (a -> Bool) -> List a -> List a

49−filter isOkay list =

50− let

51− keepIfOkay : a -> Maybe a

52− keepIfOkay x =

53− if isOkay x then Just x else Nothing

54− in

55− List.filterMap keepIfOkay list

56−```

57−

58−This case is very unfortunate because all the type annotations are correct, but there is a detail of how type inference works right now that **user-defined type variables are not shared between annotations**. This can lead to probably the worst type error messages we have because the problem here is that `a` in the outer annotation does not equal `a` in the inner annotation.

59−

60−For now the best route is to leave off the inner annotation. It is unfortunate, and hopefully we will be able to do a nicer thing in future releases.

installers/README.mddeleted−32

@@ -1,32 +0,0 @@

1−# Installing Elm

2−

3−The normal path is to work through [the guide](https://guide.elm-lang.org/) until you need to install, but you can skip to installation directly by going [here](https://guide.elm-lang.org/install/terminal.html).

4−

5−

6−

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−

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−

27−

28−## Uninstall

29−

30−- [Mac](https://github.com/elm/compiler/blob/master/installers/mac/README.md#uninstall)

31−- [Linux](https://github.com/elm/compiler/blob/master/installers/linux/README.md#uninstall)

32−- [Windows](https://github.com/elm/compiler/blob/master/installers/win/README.md#uninstall)

installers/linux/Dockerfiledeleted−39

@@ -1,39 +0,0 @@

1−# Based initially on https://gist.github.com/rlefevre/1523f47e75310e28eee243c9c5651ac9

2−#

3−# Build Linux x64 binary from elm compiler top-level directory:

4−# $ docker build -t elm -f installers/linux/Dockerfile .

5−#

6−# Retrieve elm Linux binary:

7−# $ docker cp $(docker create elm):/usr/local/bin/elm DESTINATION_DIRECTORY

8−#

9−# Delete docker elm image:

10−# $ docker rmi elm

11−#

12−# Display all images:

13−# $ docker images -a

14−#

15−# Delete all unused docker images:

16−# $ docker system prune -a

17−

18−# Use Alpine 3.11 with GHC 8.6.5

19−FROM alpine:3.11

20−

21−# Install packages required to build elm

22−RUN apk add --no-cache ghc cabal wget musl-dev zlib-dev zlib-static ncurses-dev ncurses-static

23−

24−WORKDIR /elm

25−

26−# Import source code

27−COPY builder builder

28−COPY compiler compiler

29−COPY reactor reactor

30−COPY terminal terminal

31−COPY cabal.config elm.cabal LICENSE ./

32−

33−# Build statically linked elm binary

34−RUN cabal new-update

35−RUN cabal new-build --ghc-option=-optl=-static --ghc-option=-split-sections

36−RUN cp ./dist-newstyle/build/x86_64-linux/ghc-*/elm-*/x/elm/build/elm/elm /usr/local/bin/elm

37−

38−# Remove debug symbols to optimize the binary size

39−RUN strip -s /usr/local/bin/elm

installers/linux/README.mddeleted−93

@@ -1,93 +0,0 @@

1−# Install Instructions

2−

3−The pre-compiled binary for Linux works on a very wide range of distributions.

4−

5−It should be possible to install it by running the following commands in your terminal:

6−

7−```bash

8−# Move to your Desktop so you can see what is going on easier.

9−#

10−cd ~/Desktop/

11−

12−# Download the 0.19.1 binary for Linux.

13−#

14−# +-----------+----------------------+

15−# | FLAG | MEANING |

16−# +-----------+----------------------+

17−# | -L | follow redirects |

18−# | -o elm.gz | name the file elm.gz |

19−# +-----------+----------------------+

20−#

21−curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz

22−

23−# There should now be a file named `elm.gz` on your Desktop.

24−#

25−# The downloaded file is compressed to make it faster to download.

26−# This next command decompresses it, replacing `elm.gz` with `elm`.

27−#

28−gunzip elm.gz

29−

30−# There should now be a file named `elm` on your Desktop!

31−#

32−# Every file has "permissions" about whether it can be read, written, or executed.

33−# So before we use this file, we need to mark this file as executable:

34−#

35−chmod +x elm

36−

37−# The `elm` file is now executable. That means running `~/Desktop/elm --help`

38−# should work. Saying `./elm --help` works the same.

39−#

40−# But we want to be able to say `elm --help` without specifying the full file

41−# path every time. We can do this by moving the `elm` binary to one of the

42−# directories listed in your `PATH` environment variable:

43−#

44−sudo mv elm /usr/local/bin/

45−

46−# Now it should be possible to run the `elm` binary just by saying its name!

47−#

48−elm --help

49−```

50−

51−

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−

75−

76−## Uninstall

77−

78−The following commands should remove everything:

79−

80−```bash

81−# Remove the `elm` executable.

82−#

83−sudo rm /usr/local/bin/elm

84−

85−# Remove any cached files. The files here reduce compile times when

86−# starting new projects and make it possible to work offline in more

87−# cases. No need to keep it around if you are uninstalling though!

88−#

89−rm -r ~/.elm/

90−```

91−

92−If you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.

93−

installers/mac/Distribution.xml+3−5

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

1<?xml version="1.0" encoding="utf-8" standalone="no"?>

2<installer-script minSpecVersion="1.000000" authoringTool="com.apple.PackageMaker" authoringToolVersion="3.0.6" authoringToolBuild="201">

3− <title>Elm</title>

3+ <title>Elm Platform</title>

4 <options customize="allow" allow-external-scripts="no"/>

5 <domains enable_localSystem="true"/>

6 <volume-check script="pm_volume_check();"/>

@@ -10,7 +10,7 @@

10function pm_volume_check() {

11 if(!(my.target.systemVersion && /* >= */ system.compareVersions(my.target.systemVersion.ProductVersion, '10.6.0') >= 0)) {

12 my.result.title = 'Failure';

13− my.result.message = 'This version of Elm requires Mac OS X 10.6 or later.';

13+ my.result.message = 'This version of Elm Platform requires Mac OS X 10.6 or later.';

14 my.result.type = 'Fatal';

15 return false;

16 }

@@ -18,15 +18,13 @@ function pm_volume_check() {

18}

20</script>

21− <!--

22 <background file="background.png" alignment="bottomleft" scaling="none" mime-type="image/png"/>

21 <background file="background.png" alignment="bottomleft" scaling="none" mime-type="image/png"/>

23− -->

24 <welcome mime-type="text/rtf" file="welcome.rtf" />

22 <welcome mime-type="text/rtf" file="welcome.rtf" />

25 <conclusion mime-type="text/rtf" file="conclusion.rtf" />

23 <conclusion mime-type="text/rtf" file="conclusion.rtf" />

26 <choices-outline>

24 <choices-outline>

27 <line choice="choice2"/>

25 <line choice="choice2"/>

28 </choices-outline>

26 </choices-outline>

29− <choice id="choice2" title="Elm">

27+ <choice id="choice2" title="Elm Platform ">

30 <pkg-ref id="org.elm-lang.binaries.pkg"/>

28 <pkg-ref id="org.elm-lang.binaries.pkg"/>

31 </choice>

29 </choice>

32 <pkg-ref id="org.elm-lang.binaries.pkg" installKBytes="19444" version="1" auth="Root">binaries.pkg</pkg-ref>

30 <pkg-ref id="org.elm-lang.binaries.pkg" installKBytes="19444" version="1" auth="Root">binaries.pkg</pkg-ref>

installers/mac/README.mddeleted−93

@@ -1,93 +0,0 @@

1−# Install Instructions

2−

3−The easiest way to install is to to use [the Mac installer](https://github.com/elm/compiler/releases/download/0.19.1/installer-for-mac.pkg)!

4−

5−But it is also possible to install by running the following commands in your terminal:

6−

7−```bash

8−# Move to your Desktop so you can see what is going on easier.

9−#

10−cd ~/Desktop/

11−

12−# Download the 0.19.1 binary for Linux.

13−#

14−# +-----------+----------------------+

15−# | FLAG | MEANING |

16−# +-----------+----------------------+

17−# | -L | follow redirects |

18−# | -o elm.gz | name the file elm.gz |

19−# +-----------+----------------------+

20−#

21−curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-mac-64-bit.gz

22−

23−# There should now be a file named `elm.gz` on your Desktop.

24−#

25−# The downloaded file is compressed to make it faster to download.

26−# This next command decompresses it, replacing `elm.gz` with `elm`.

27−#

28−gunzip elm.gz

29−

30−# There should now be a file named `elm` on your Desktop!

31−#

32−# Every file has "permissions" about whether it can be read, written, or executed.

33−# So before we use this file, we need to mark this file as executable:

34−#

35−chmod +x elm

36−

37−# The `elm` file is now executable. That means running `~/Desktop/elm --help`

38−# should work. Saying `./elm --help` works the same.

39−#

40−# But we want to be able to say `elm --help` without specifying the full file

41−# path every time. We can do this by moving the `elm` binary to one of the

42−# directories listed in your `PATH` environment variable:

43−#

44−sudo mv elm /usr/local/bin/

45−

46−# Now it should be possible to run the `elm` binary just by saying its name!

47−#

48−elm --help

49−```

50−

51−

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−

66−

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−

72−

73−

74−

75−

76−## Uninstall

77−

78−The following commands should remove everything:

79−

80−```bash

81−# Remove the `elm` executable.

82−#

83−sudo rm /usr/local/bin/elm

84−

85−# Remove any cached files. The files here reduce compile times when

86−# starting new projects and make it possible to work offline in more

87−# cases. No need to keep it around if you are uninstalling though!

88−#

89−rm -r ~/.elm/

90−```

91−

92−If you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.

93−

installers/mac/Resources/en.lproj/background.pngnew file

Binary file not shown.

installers/mac/Resources/en.lproj/conclusion.rtf+6−13

@@ -1,16 +1,9 @@

1−{\rtf1\ansi\ansicpg1252\cocoartf2509

1+{\rtf1\ansi\ansicpg1252\cocoartf1187\cocoasubrtf400

2−\cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;}

2+{\fonttbl\f0\fswiss\fcharset0 Helvetica;}

3{\colortbl;\red255\green255\blue255;}

4−{\*\expandedcolortbl;;}

4+\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0

5−\paperw11900\paperh16840\margl1440\margr1440\vieww11180\viewh8400\viewkind0

5+\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural

6−\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200\tx7920\tx8640\pardirnatural\partightenfactor0

8−\f0\fs28 \cf0 Try opening the terminal and running commands like:\

7+\f0\fs26 \cf0 A bunch of useful programs were just placed in /usr/local/bin/\

10−

9+Check out {\field{\*\fldinst HYPERLINK "http://elm-lang.org/Get-Started.elm"}{\fldrslt this tutorial}} to learn how to use them!}

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+4−9

@@ -1,12 +1,7 @@

1−{\rtf1\ansi\ansicpg1252\cocoartf2509

1+{\rtf1\ansi\ansicpg1252\cocoartf1187\cocoasubrtf400

2−\cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;}

2+{\fonttbl\f0\fswiss\fcharset0 Helvetica;}

3{\colortbl;\red255\green255\blue255;}

4−{\*\expandedcolortbl;;}

5\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0

4\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0

6−\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural\partightenfactor0

5+\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural

8−\f0\fs28 \cf0 Thank you for trying out Elm!\

7+\f0\fs28 \cf0 This package will install Elm on your machine.}

9−\

10−This installer makes

11−\f1 elm

12−\f0 available in your terminal.}

installers/mac/helper-scripts/elm-startup.sh+1−1

@@ -1,3 +1,3 @@

1#!/bin/sh

3−open 'http://guide.elm-lang.org'

3+open 'http://elm-lang.org'

installers/mac/make-installer.sh+3−30

@@ -29,8 +29,7 @@ cp $(pwd)/preinstall $pkg_scripts

29cp $(pwd)/postinstall $pkg_scripts

31pkgbuild \

32− --sign "Developer ID Installer: <NAME>" \

32+ --identifier org.elm-lang.binaries.pkg \

33− --identifier org.elm-lang.binary \

34 --install-location $usr_binaries \

33 --install-location $usr_binaries \

35 --scripts $pkg_scripts \

34 --scripts $pkg_scripts \

36 --filter 'Scripts.*' \

35 --filter 'Scripts.*' \

@@ -40,42 +39,16 @@ pkgbuild \

41#### BUNDLE ASSETS ####

40#### BUNDLE ASSETS ####

43−rm -f installer-for-mac.pkg

42+rm -f Elm.pkg

45productbuild \

44productbuild \

46− --sign "Developer ID Installer: <NAME>" \

47− --identifier org.elm-lang.installer \

48 --distribution Distribution.xml \

45 --distribution Distribution.xml \

49 --package-path . \

46 --package-path . \

50 --resources Resources \

47 --resources Resources \

51− installer-for-mac.pkg

48+ Elm.pkg

54#### CLEAN UP ####

51#### CLEAN UP ####

56rm binaries.pkg

53rm binaries.pkg

57rm -rf $pkg_root

54rm -rf $pkg_root

58−

59−

60−#### BEGIN NOTARIZATION ####

61−

62−xcrun altool \

63− --notarize-app \

64− --primary-bundle-id "org.elm-lang.installer" \

65− --username "<EMAIL>" \

66− --password "@keychain:Developer-altool" \

67− --file "installer-for-mac.pkg"

68−

69−# From https://scriptingosx.com/2019/09/notarize-a-command-line-tool/

70−#

71−#### Check on notarization:

72−#

73−# xcrun altool \

74−# --notarization-info "<RequestUUID>" \

75−# --username "<EMAIL>" \

76−# --password "@keychain:Developer-altool"

77−#

78−#

79−#### Staple Notarization:

80−#

81−# xcrun stapler staple installer-for-mac.pkg

installers/npm/PUBLISHING.md+141−29

@@ -1,59 +1,171 @@

1−# Publishing

1+# Publishing a new release

3−Here's how to update the `npm` installer.

3+A new version of Elm came out. Huzzah! Here's how to update the `npm` installer.

5+## 1. Create tarballs of binaries

6−## 1. GitHub Release

7+You can find a list of what binaries we'll need to tar up in `index.js`.

8−Create a [GitHub Release](https://github.com/elm/compiler/releases) with the following files:

9+For example:

10−1. `binary-for-mac-64-bit.gz`

11+```javascript

11−2. `binary-for-windows-64-bit.gz`

12+var root =

12−3. `binary-for-linux-64-bit.gz`

13+ "https://github.com/elm/compiler/releases/download/" +

14+ binVersion +

15+ "/binaries-for-";

14−Create each of these by running the `elm` executable for each platform through `gzip elm`.

17+module.exports = binwrap({

18+ binaries: ["elm"],

19+ urls: {

20+ "darwin-x64": root + "mac.tar.gz",

21+ "win32-x64": root + "windows.tar.gz",

22+ "win32-ia32": root + "windows.tar.gz",

23+ "linux-x64": root + "linux.tar.gz"

24+ }

25+});

26+```

27+

28+If this is the end of your `index.js`, you'll need to create these files:

30+1. `binaries-for-mac.tar.gz`

31+2. `binaries-for-windows.tar.gz`

32+3. `binaries-for-linux.tar.gz`

17−## 2. Try a beta release

34+Each of these tarballs should have **only the Elm binary** inside them - no

35+directories!

19−In `package.json`, bump the version to `"0.19.2-beta"`.

37+So create them by making a directory, putting all the binaries in it, `cd`-ing

38+into that directory, and then running something like this:

21−```bash

40+```shell

22−npm publish --tag beta

41+$ tar cvzf binaries-for-linux.tar.gz elm

23```

42```

25−To test that it works, run these commands:

44+Make sure each tarball contains all the binaries listed in that `binaries:` list

45+in `index.js`. (The Windows ones should have `.exe` at the end; `binwrap`

46+expects that they will, for Windows only.)

47+

48+## 2. Update the `bin/` binary wrappers

49+

50+Inside the npm installer's `bin/` directory, there should be a file for each of

51+the binaries that will be included in this release.

52+

53+Each of these must be executable! If you're not sure whether they are,

54+run `chmod +x` on them just to be sure.

55+

56+Their paths must also must all be listed in `package.json` in two places:

57+

58+1. The `"files":` field

59+2. The `"bin":` field

60+

61+If the executables are the same as they were for the last release, great!

62+You can proceed to the next step. If any binaries were removed, make sure to

63+remove them from these lists!

64+

65+## 3. Update `package.json` for a beta release

66+

67+In `package.json`, bump the version to the next applicable release, and add

68+a `"-beta"` suffix to it.

69+

70+For example, if it was on `"0.18.0"` you might bump it to `"0.19.0-beta"`.

71+The version number should match the release of Elm, such that if people do

72+`npm install elm@0.19.0@beta` they get what they would expect.

73+

74+## 4. Tag the beta release

75+

76+Commit this change and tag it with the name of the release **without** the

77+`-beta` suffix. (We will overwrite this tag later.)

78+

79+For example:

27−```bash

81+```shell

28−npm dist-tags ls elm

82+$ git tag 0.19.0

29−npm install elm@beta --ignore-scripts

83+$ git push origin 0.19.0

30```

84```

32−The `latest` tag should not be changed, and there should be an additional `beta` tag.

86+Now this tag should exist on GitHub, allowing us to upload binaries to it.

34−Try this on Windows, Linux, and Mac.

88+## 5. Upload binaries

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.

37−## 3. Publish final release

95+Upload the tarballs you created in step 1.

39−Remove the `-beta` suffix from the version in `package.json`. Then run:

97+## 6. Publish beta release

41−```bash

99+Run this to publish the beta release. The `--tag beta` is **crucial** here.

42−npm publish

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

43```

106```

107

108+Afterwards you should be able to do `npm info elm | less` and see something

109+like this in the JSON:

110+

111+```

112+'dist-tags': { latest: '0.18.0', beta: '0.19.0-beta' }

113+```

114

46−## 4. Tag the `latest-0.19.1` version

115+If you messed this up, and the `latest` tag now points to the beta you just

116+published, don't panic - it's fixable! `dist-tags` can always be modified after

117+the fact. Read up on `npm` [dist-tags](https://docs.npmjs.com/cli/dist-tag)

118+to learn how to fix things.

119

48−Many compiler releases have needed multiple `npm` publications. Maybe something does not work on Windows or some dependency becomes insecure. Normal `npm` problems.

120+## 7. Verify beta installer

121

50−The convention for each Elm release is to create a tag the latest one.

122+Make an empty directory and run `npm init` inside it.

123

52−```bash

124+Then run this:

53−npm dist-tag add elm@0.19.1-3 latest-0.19.1

125+

126+```shell

127+$ npm install elm@beta --ignore-scripts

54```

128```

129

56−That way people who want a specific version can point to `latest-0.19.1` or `latest-0.18.0` instead of knowing the particular names of all the various publications.

130+This should succeed with an exit code of `0`.

131+If it did, look in `node_modules/.bin/` for the binaries you expect.

132+They should be present, and they should also work as expected when you run them.

133+Because you installed them with `--ignore-scripts`, the first thing they should

134+do is to download themselves and then execute whatever command you requested

135+(e.g. `node_modules/.bin/elm make Main.elm`). If you run the same command a

136+second time, it should run faster because it doesn't have to download the binary

137+first.

138+

139+Now try it again with `--ignore-scripts` turned off:

140+

141+```shell

142+$ rm -r node_modules

143+$ npm install elm@beta --ignore-scripts=false

144+```

145+

146+This time it should download the binaries during the installation phase. Once

147+again you should be able to run the binaries from `node_modules/.bin/`, and

148+this time they should be fast from the first run because they're already

149+downloaded.

150+

151+## 8. Publish for real

152+

153+It's a good idea to ask others to try out the beta installer before doing this!

154+Especially on multiple operating systems.

155+

156+To publish the real version:

157+

158+1. Edit `package.json` to remove the `-beta` suffix from the version.

159+2. Commit that change and push it.

160+3. Use `git tag --force` to overwrite the previous tag (e.g. `0.19.0` - whatever you used before).

161+4. Force push the tag, e.g. `git push origin 0.19.0 --force-with-lease`.

162+5. `npm publish`

163

58−You can read more about dist-tags [here](https://docs.npmjs.com/cli/dist-tag).

164+You're done! Now whenever anyone does `npm install -g elm` they'll get the

165+version you just uploaded.

166

167+The reason we only used the `-beta` suffix for `npm` was so that when we ran

168+tests on the beta version, it was all against the same (non-beta) URLs we'd end

169+up using for the real version. This means there's no opportunity for us to

170+introduce some sort of mismatch between the beta that we verified and the real

171+version.

installers/npm/README.md+23−30

@@ -1,45 +1,38 @@

1−# Elm Installer

1+npm install elm [![Travis build Status](https://travis-ci.org/elm-lang/elm-platform.svg?branch=master)](http://travis-ci.org/elm-lang/elm-platform) [![AppVeyor build status](https://ci.appveyor.com/api/projects/status/6mcub79i04ianpm9/branch/master?svg=true)](https://ci.appveyor.com/project/rtfeldman/elm-platform/branch/master)

2+===============

3−[Elm](https://elm-lang.org) is a functional programming language that compiles to JavaScript.

4+Install the [Elm Platform](https://github.com/elm-lang/elm-platform) via [`npm`](https://www.npmjs.com).

5−Head over to [The Official Guide](https://guide.elm-lang.org/) to start learning Elm!

6+## Installing

8+Run this to get the binaries:

8−

10+```

9−

11+$ npm install -g elm

10−## What is this package for?

12+```

11−

12−**Normal installs** ❌

13−

14−Use the instructions [here](https://guide.elm-lang.org/install/elm.html) instead.

15−

16−**Multiple versions** ✅

17−

18−People using Elm at work may use different versions of Elm in different projects. They can run `npm install elm@latest-0.19.1` in each project and use the binary at `./node_modules/.bin/elm` for compilation.

19−

20−**Continuous integration** ⚠️

21−

22−This works, but there are usually faster and more reliable options:

23−

24−1. You can download `elm` directly from GitHub with [this script](https://github.com/elm/compiler/blob/master/installers/linux/README.md). This is all the `npm` installer does, but with extra HTTP requests to `npmjs.com` servers, making it slower and adding more failure points.

25−2. Many continuous integration have ways to cache files ([example](https://docs.travis-ci.com/user/caching/)) to make builds faster and more reliable.

26−

27−That said, it will definitely work to use the `npm` installer on CI if you prefer that option.

14+## Installing behind a proxy server

30−

16+If you are behind a proxy server, set the environment variable "HTTPS_PROXY".

32−## Install Locally

18+```

19+$ export HTTPS_PROXY=$YourProxyServer$

20+$ npm install -g elm

21+```

34−The following command should download the latest Elm 0.19.1 binary:

23+Or on Windows:

36```

25```

37−npm install elm@latest-0.19.1

26+$ set HTTPS_PROXY=$YourProxyServer$

27+$ npm install -g elm

38```

28```

40−You should be able to run `./node_modules/bin/elm --version` within your project and see `0.19.1`. Now you can compile with `./node_modules/bin/elm make src/Main.elm` and not disrupt other packages.

30+## Troubleshooting

42−Use `npm install elm@latest-0.19.0` or `npm install elm@latest-0.18.0` for earlier versions.

32+1. [Troubleshooting npm](https://github.com/npm/npm/wiki/Troubleshooting)

33+2. On Debian/Ubuntu systems, you may have to install the nodejs-legacy package: `apt-get install nodejs-legacy`.

34+3. If the installer says that it cannot find any usable binaries for your operating system and architecture, check the [Build from Source](https://github.com/elm-lang/elm-platform/blob/master/README.md#build-from-source) documentation.

44−**Note:** The `latest-X.Y.Z` convention is used in case we need to publish patches for the `npm` installer within a given Elm release. For example, say `npm` decides that some transitive dependency is not secure. Nothing is changing about Elm or the binaries, but we need to publish a new `npm` installer that fixes this issue.

36+## Getting Started

38+Once everything has installed successfully, head over to the [Get Started](http://elm-lang.org/Get-Started.elm) page!

installers/npm/bin/elm+16−42

@@ -1,54 +1,28 @@

1#!/usr/bin/env node

3var child_process = require('child_process');

4−var path = require('path');

4+var download = require('../download.js');

5var fs = require('fs');

8−// Some npm users enable --ignore-scripts (a good security measure) so

8+// Some npm users enable --ignore-scripts (a good security measure)

9−// they do not run the post-install hook and install.js does not run.

10−// Instead they will run this script.

11//

9//

12−// On Mac and Linux, we download the elm executable into the exact same

10+// They do not run the post-install hook, so install.js does not run.

13−// location as this file. Since npm uses symlinks on these platforms,

14−// that means that the first run will invoke this file and subsequent

15−// runs will call the elm binary directly.

16//

11//

17−// On Windows, we must download a file named elm.exe for it to run properly.

12+// This file pretends to be the downloaded binary. It then downloads

18−// Instead of symlinks, npm creates two files:

13+// the real binary over itself. So in that case, the first run would

19−//

14+// also make an HTTPS request to fetch the real binary.

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.

28−// figure out where to put the binary (calls path.resolve() to get path separators right on Windows)

29−//

30−var binaryPath = path.resolve(__dirname, 'elm') + (process.platform === 'win32' ? '.exe' : '');

31−

32−// Run the command directly if possible, otherwise download and then run.

33−// This check is important for Windows where this file will be run all the time.

34−//

35−if (process.platform === 'win32')

36−{

37− fs.existsSync(binaryPath)

38− ? runCommand()

39− : require('../download.js')(runCommand);

40−}

41−else

42−{

43− require('../download.js')(runCommand);

44−}

18+// 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]);

47−function runCommand()

22+download(pathToThisFile, function() {

48−{

23+ // Need double quotes and { shell: true } when there are spaces in the path on windows:

49− // Need double quotes and { shell: true } when there are spaces in the path on windows:

24+ // https://github.com/nodejs/node/issues/7367#issuecomment-229721296

50− // https://github.com/nodejs/node/issues/7367#issuecomment-229721296

25+ child_process

51− child_process

26+ .spawn('"' + pathToThisFile + '"', process.argv.slice(2), { stdio: 'inherit', shell: true })

52− .spawn('"' + binaryPath + '"', process.argv.slice(2), { stdio: 'inherit', shell: true })

27+ .on('exit', process.exit);

53− .on('exit', process.exit);

28+});

54−}

installers/npm/download.js+67−68

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

1var fs = require('fs');

2var package = require('./package.json');

3−var path = require('path');

3+var URL = require('url').URL;

4−var request = require('request');

4+var https = require('https');

5var zlib = require('zlib');

@@ -12,72 +12,87 @@ var zlib = require('zlib');

12// called when --ignore-scripts is enabled. That's why install.js is so weird.

15−module.exports = function(callback)

15+module.exports = function(destinationPath, callback)

16{

17− // figure out URL of binary

18 var version = package.version.replace(/^(\d+\.\d+\.\d+).*$/, '$1'); // turn '1.2.3-alpha' into '1.2.3'

17 var version = package.version.replace(/^(\d+\.\d+\.\d+).*$/, '$1'); // turn '1.2.3-alpha' into '1.2.3'

18+ var os = { 'darwin': 'mac', 'win32': 'windows', 'linux': 'linux' }[process.platform];

19+ var arch = { 'x64': '64-bit', 'ia32': '32-bit' }[process.arch];

20− var platform = {

21+ download(

21− darwin_x64: 'mac-64-bit',

22+ process.platform === 'win32' ? destinationPath + '.exe' : destinationPath,

22− darwin_arm64: 'mac-64-bit',

23+ 'https://github.com/elm/compiler/releases/download/' + version + '/binary-for-' + os + '-' + arch + '.gz',

23− win32_x64: 'windows-64-bit',

24+ callback

24− linux_x64: 'linux-64-bit'

25+ );

25− }[process.platform + '_' + process.arch];

26+};

26−

27− verifyPlatform(version, platform);

28−

29− var url = 'https://github.com/elm/compiler/releases/download/' + version + '/binary-for-' + platform + '.gz';

31− reportDownload(version, url);

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' : '');

36− // set up handler for request failure

30+// DOWNLOAD

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

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− });

47− // set up file write pipe

33+function download(destinationPath, url, callback)

48− var write = fs.createWriteStream(binaryPath, {

34+{

49− encoding: 'binary',

35+ requestWithRedirects(url, 10,

50− mode: 0o755

36+ function(error) {

51− }).on('finish', callback).on('error', function(error) {

37+ exitFailure(url, 'I ran into trouble while fetching ' + url + '\n\n' + error);

52− exitFailure(url, 'I had some trouble writing file to disk. It is saying:\n\n' + error);

38+ },

53− });

39+ function(response) {

54−

40+ if (response.statusCode == 404)

55− // put it all together

41+ {

56− request(url).on('error', reportDownloadFailure).pipe(gunzip).pipe(write);

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

57}

65}

61−// VERIFY PLATFORM

69+// HANDLE REDIRECTS

64−function verifyPlatform(version, platform)

72+function requestWithRedirects(url, maxRedirects, failure, success)

65{

73{

66− if (platform) return;

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+ });

68− var situation = process.platform + '_' + process.arch;

93+ req.on('error', failure);

69− console.error(

94+

70− '-- ERROR -----------------------------------------------------------------------\n\n'

95+ req.end();

71− + 'I am detecting that your computer (' + situation + ') may not be compatible with any\n'

72− + 'of the official pre-built binaries.\n\n'

73− + 'I recommend against using the npm installer for your situation. Check out the\n'

74− + 'alternative installers at https://github.com/elm/compiler/releases/tag/' + version + '\n'

75− + 'to see if there is something that will work better for you.\n\n'

76− + 'From there I recommend asking for guidance on Slack or Discourse to find someone\n'

77− + 'who can help with your specific situation.\n\n'

78− + '--------------------------------------------------------------------------------\n'

79− );

80− process.exit(1);

81}

96}

@@ -96,19 +111,3 @@ function exitFailure(url, message)

96 );

111 );

97 process.exit(1);

112 process.exit(1);

98}

113}

99−

100−

101−

102−// REPORT DOWNLOAD

103−

104−

105−function reportDownload(version, url)

106−{

107− console.log(

108− '--------------------------------------------------------------------------------\n\n'

109− + 'Downloading Elm ' + version + ' from GitHub.'

110− + '\n\nNOTE: You can avoid npm entirely by downloading directly from:\n'

111− + url + '\nAll this package does is download that file and put it somewhere.\n\n'

112− + '--------------------------------------------------------------------------------\n'

113− );

114−}

installers/npm/install.js+7−1

@@ -1,4 +1,10 @@

2var download = require('./download.js');

3+var package = require('./package.json');

4+var path = require('path');

4−download(function() {});

7+// get slashes right for Windows

8+var targetPath = path.resolve(__dirname, Object.values(package.bin)[0]);

10+download(targetPath, function() {});

installers/npm/package.json+7−6

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

2 "name": "elm",

3− "version": "0.19.1-5",

3+ "version": "0.19.0-no-deps",

4 "description": "Installer for Elm: just downloads the binary into node_modules",

5 "preferGlobal": true,

6 "license": "BSD-3-Clause",

@@ -11,9 +11,9 @@

11 "homepage": "https://github.com/elm/compiler/tree/master/installers/npm",

12 "bugs": "https://github.com/elm/compiler/issues",

13 "author": {

14− "name": "Evan Czaplicki",

14+ "name": "Richard Feldman",

15− "email": "evan@elm-lang.org",

15+ "email": "richard.t.feldman@gmail.com",

16− "url": "https://github.com/evancz"

16+ "url": "https://github.com/rtfeldman"

17 },

18 "engines": {

19 "node": ">=7.0.0"

@@ -35,8 +35,9 @@

35 "install",

36 "installer"

37 ],

38− "bin": { "elm": "bin/elm" },

38+ "bin": {

39+ "elm": "bin/elm"

40+ },

39 "dependencies": {

41 "dependencies": {

40− "request": "^2.88.0"

41 }

42 }

42}

43}

installers/npm/troubleshooting.mddeleted−76

@@ -1,76 +0,0 @@

1−# Troubleshooting

2−

3−I very highly recommend asking for help on [the Elm slack](https://elmlang.herokuapp.com).

4−

5−There are a lot of things that can go wrong when installing software, and it can really help to have a second pair of eyes on your situation!

6−

7−This document goes through a couple options that may help you out.

8−

9−

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−

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−

61−

62−

63−## Do you know what a `PATH` variable is?

64−

65−When you run a command like `elm make src/Main.elm`, your computer starts by trying to find a file called `elm`.

66−

67−The `PATH` is a list of directories to search within. On Mac and Linux, you can see these directories by running:

68−

69−```

70−$ echo $PATH

71−/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/local/git/bin

72−```

73−

74−The are separated by `:` for some reason. So running `elm make src/Main.elm` starts by searching the `PATH` for files named `elm`. On my computer, it finds `/usr/local/bin/elm` and then can actually run the command.

75−

76−Is `elm` in one of the directories listed in your `PATH` variable? I recommend asking for help if you are in this scenario and unsure how to proceed.

installers/win/Nsisfile.nsi+16−16

@@ -75,7 +75,7 @@ Function un.onInit

75FunctionEnd

77Function LaunchLink

78− ExecShell "open" "https://guide.elm-lang.org"

78+ ExecShell "open" "http://elm-lang.org/get-started"

79FunctionEnd

81;--------------------------------

@@ -135,20 +135,20 @@ SectionEnd

135

136SectionGroup "Update system settings" SecGr

137

138−;Section "Associate with .elm files" SecAssoc

138+Section "Associate with .elm files" SecAssoc

139−;

139+

140−; SectionIn 1

140+ SectionIn 1

141−;

141+

142−; ; File associations

142+ ; File associations

143−; WriteRegStr HKCR ".elm" "" "elm"

143+ WriteRegStr HKCR ".elm" "" "elm"

144−; WriteRegStr HKCR "elm" "" "Elm Source File"

144+ WriteRegStr HKCR "elm" "" "Elm Source File"

145−; WriteRegStr HKCR "elm\DefaultIcon" "" "$INSTDIR\file.ico"

145+ WriteRegStr HKCR "elm\DefaultIcon" "" "$INSTDIR\file.ico"

146−; WriteRegStr HKCR "elm\shell\open\command" "" '"$INSTDIR\bin\elm.exe" "%1"'

146+ ;WriteRegStr HKCR "elm\shell\open\command" "" '"$INSTDIR\bin\elm.exe" "%1"'

147−;

147+

148−; ;Remember that we registered associations

148+ ;Remember that we registered associations

149−; WriteRegDWORD HKLM "${PRODUCT_DIR_REG_KEY}" Assocs 0x1

149+ WriteRegDWORD HKLM "${PRODUCT_DIR_REG_KEY}" Assocs 0x1

150−;

150+

151−;SectionEnd

151+SectionEnd

152

153Section "Update the PATH environment variable" SecPath

154

@@ -261,4 +261,4 @@ Section "Uninstall"

261 ; Update environment variables

262 SendMessage ${HWND_BROADCAST} ${WM_SETTINGCHANGE} 0 "STR:Environment" /TIMEOUT=5000

263

264−SectionEnd

264+SectionEnd

installers/win/README.md+3−18

@@ -1,24 +1,9 @@

1−# Installing on Windows

1+# Building Windows installer

2−

3−The installer for Windows is available [here](https://guide.elm-lang.org/install.html).

4−

5−

6−

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−

15−

16−## Building the Windows installer

18You will need the [NSIS installer](http://nsis.sourceforge.net/Download) to be installed.

3You will need the [NSIS installer](http://nsis.sourceforge.net/Download) to be installed.

20Once everything is installed, run something like this command:

5Once everything is installed, run something like this command:

22− make_installer.cmd 0.19.0

7+ make_installer.cmd 0.19

24−It will build an installer called `Elm-0.19.0-setup.exe`.

9+It will build an installer called `Elm-0.19-setup.exe`.

installers/win/file.iconew file

Binary file not shown.

installers/win/inst.dat+2−1

@@ -2,5 +2,6 @@ SetOutPath "$INSTDIR\bin"

2File "${FILES_SOURCE_PATH}\bin\elm.exe"

4SetOutPath "$INSTDIR"

5+File "file.ico"

5File "updatepath.vbs"

6File "updatepath.vbs"

6−File "removefrompath.vbs"

7+File "removefrompath.vbs"

installers/win/logo.ico

Binary file not shown.

installers/win/uninst.dat+2−1

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

1Delete "$INSTDIR\bin\elm.exe"

2RmDir "$INSTDIR\bin"

4+Delete "$INSTDIR\file.ico"

4Delete "$INSTDIR\updatepath.vbs"

5Delete "$INSTDIR\updatepath.vbs"

5Delete "$INSTDIR\removefrompath.vbs"

6Delete "$INSTDIR\removefrompath.vbs"

6−RmDir "$INSTDIR"

7+RmDir "$INSTDIR"

installers/win/welcome.bmp

Binary file not shown.

reactor/assets/waiting.gifnew file

Binary file not shown.

reactor/elm.json+2−2

@@ -3,7 +3,7 @@

3 "source-directories": [

4 "src"

5 ],

6− "elm-version": "0.19.1",

6+ "elm-version": "0.19.0",

7 "dependencies": {

8 "direct": {

9 "elm/browser": "1.0.1",

@@ -28,4 +28,4 @@

28 "direct": {},

29 "indirect": {}

30 }

31−}

31+}

reactor/src/Index.elm+15−20

@@ -64,7 +64,7 @@ decoder =

64 (D.field "dirs" (D.list D.string))

65 (D.field "files" (D.list fileDecoder))

66 (D.field "readme" (D.nullable D.string))

67− (D.field "outline" (D.nullable Project.decoder))

67+ (D.field "project" (D.nullable Project.decoder))

68 (D.field "exactDeps" (D.dict Version.decoder))

@@ -219,10 +219,10 @@ viewDeps exactDeps project =

219 dependencies =

220 case project of

221 Project.Application info ->

222− List.map viewVersion info.depsDirect

222+ List.map (viewDependency exactDeps) info.depsDirect

223

224 Project.Package info ->

225− List.map (viewConstraint exactDeps) info.deps

225+ List.map (viewDependency exactDeps) info.deps

226 in

227 Skeleton.box

228 { title = "Dependencies"

@@ -237,10 +237,10 @@ viewTestDeps exactDeps project =

237 dependencies =

238 case project of

239 Project.Application info ->

240− List.map viewVersion info.testDepsDirect

240+ List.map (viewDependency exactDeps) info.testDepsDirect

241

242 Project.Package info ->

243− List.map (viewConstraint exactDeps) info.testDeps

243+ List.map (viewDependency exactDeps) info.testDeps

244 in

245 Skeleton.box

246 { title = "Test Dependencies"

@@ -249,22 +249,9 @@ viewTestDeps exactDeps project =

249 }

250

251

252−viewVersion : (Package.Name, Version.Version) -> List (Html msg)

252+viewDependency : ExactDeps -> (Package.Name, vsn) -> List (Html msg)

253−viewVersion (pkg, version) =

253+viewDependency exactDeps (pkg, _) =

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, _) =

264 case Dict.get (Package.toString pkg) exactDeps of

254 case Dict.get (Package.toString pkg) exactDeps of

265− Just vsn ->

266− viewVersion (pkg, vsn)

267−

268 Nothing ->

255 Nothing ->

269 [ div [ style "float" "left" ]

256 [ div [ style "float" "left" ]

270 [ Icon.package

257 [ Icon.package

@@ -273,6 +260,14 @@ viewConstraint exactDeps (pkg, _) =

273 , div [ style "float" "right" ] [ text "???" ]

260 , div [ style "float" "right" ] [ text "???" ]

274 ]

261 ]

275

262

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+

276

271

277toPackageUrl : Package.Name -> Version.Version -> String

272toPackageUrl : Package.Name -> Version.Version -> String

278toPackageUrl name version =

273toPackageUrl name version =

reactor/src/Index/Navigator.elm+1−1

@@ -19,7 +19,7 @@ view root dirs =

19 , style "align-items" "center"

20 , style "height" "40px"

21 ]

22− (makeLinks root dirs "" [])

22+ (makeLinks root dirs "/" [])

25makeLinks : String -> List String -> String -> List (Html msg) -> List (Html msg)

roadmap.mddeleted−29

@@ -1,29 +0,0 @@

1−# Roadmap

2−

3−If you like what you see now, that's pretty much what Elm is going to be for a while.

4−

5−I'm currently doing some exploratory work with compiler techniques and targets, but it is still too early to tell which parts of that might work out. I know many readers take "exploring X" as a promise that "X will definitely happen", so I want to be careful in setting expectations low since there is still so much uncertainty in the work. So while there is no real news to share at this point, I can give some expectations about future stability of Elm:

6−

7−**If this exploratory work goes well**, even in the wildest version of success, I wouldn't expect the language or core packages to change very much. Maybe two or three years down the line it could reveal something that'd be good to fix up, but I don't really foresee notable changes right now.

8−

9−**If this exploratory work does not work out**, I have some more conservative projects that are good ideas that I want to circle back to at some point. Things like:

10−

11−- add a constrained type variable `eq` to get rid of the runtime error for `(==)` on functions

12−- try to integrate `elm test` so it can run only tests that changed

13−- try to get `elm format` using the latest parsing infrastructure so it's not a perf bottleneck during development anymore

14−- do another round on perf because I have one last idea that can squeeze out a bit more speed

15−

16−These are all nice quality of life things, but with 0.19.0 and 0.19.1 taking so long, I got pretty burnt out on "incremental improvements that are good ideas, but take a very long time and aren't very exciting to non-Elm users." Without getting too into the details, I really needed to change things up before returning to these particular ideas.

17−

18−If someone has a security issue from the compiler or core libraries, please DM me about it on the Elm Slack. Outside of security issues, I think capacity for more discretionary changes will increase once the lessons from the compiler explorations become more clear. Hopefully the discussion [here](https://discourse.elm-lang.org/t/costs-funding-in-open-source-languages/5722) clarifies the thinking on these capacity questions a bit.

19−

20−

21−

22−

23−**Taking a step back**, I have found that working in this looser style has produced a high baseline of quality, and I think that is an important part of Elm. For example, all the error message work in Elm began as a project to implement the `--report=json` flag. That work happened to reveal some cool ideas on improving error messages, and if I had been using a rigid roadmap, I might have skipped those ideas to meet the publicly-stated arbitrary deadline. We'd have a clearer roadmap, but error messages no different than other type-inferred languages.

24−

25−So I think having more flexibility in planning is a competitive advantage for Elm in certain ways, but it is obviously a trade off that does not work for everyone. If someone needs more certainty, I generally recommend looking into other languages to see if they have a balance that works better for their needs. For example, languages made by big corporations are generally "less risky" on things like this, but I think you see the fruits of that kind of process in the design decisions as well. Trade offs!

26−

27−Anyway, like I said at the beginning, if you like what you see now, that's what it's going to be for a while. Even in the best case scenario with my current explorations!

28−

29−I hope this is helpful information, and I hope you have a good experience with Elm, even if you ultimately find a different language that works better for you!

terminal/src/Bump.hs+8−158

@@ -1,31 +1,10 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+module Bump (run) where

2−module Bump

3− ( run

4− )

5− where

8−import qualified Data.List as List

4+import qualified Elm.Bump as Bump

9−import qualified Data.NonEmptyList as NE

5+import qualified Elm.Project as Project

10−

11−import qualified BackgroundWriter as BW

12−import qualified Build

13−import qualified Deps.Bump as Bump

14−import qualified Deps.Diff as Diff

15−import qualified Deps.Registry as Registry

16−import qualified Elm.Details as Details

17−import qualified Elm.Docs as Docs

18−import qualified Elm.Magnitude as M

19−import qualified Elm.Outline as Outline

20−import qualified Elm.Version as V

21−import qualified Http

22−import Reporting.Doc ((<>), (<+>))

23−import qualified Reporting

24−import qualified Reporting.Doc as D

25−import qualified Reporting.Exit as Exit

26−import qualified Reporting.Exit.Help as Help

27import qualified Reporting.Task as Task

6import qualified Reporting.Task as Task

28−import qualified Stuff

7+import qualified Reporting.Progress.Terminal as Terminal

@@ -34,136 +13,7 @@ import qualified Stuff

35run :: () -> () -> IO ()

14run :: () -> () -> IO ()

36run () () =

15run () () =

37− Reporting.attempt Exit.bumpToReport $

16+ do reporter <- Terminal.create

38− Task.run (bump =<< getEnv)

17+ Task.run reporter $

39−

18+ do summary <- Project.getRoot

40−

19+ Bump.bump summary

41−

42−-- ENV

43−

44−

45−data Env =

46− Env

47− { _root :: FilePath

48− , _cache :: Stuff.PackageCache

49− , _manager :: Http.Manager

50− , _registry :: Registry.Registry

51− , _outline :: Outline.PkgOutline

52− }

53−

54−

55−getEnv :: Task.Task Exit.Bump Env

56−getEnv =

57− do maybeRoot <- Task.io $ Stuff.findRoot

58− case maybeRoot of

59− Nothing ->

60− Task.throw Exit.BumpNoOutline

61−

62− Just root ->

63− do cache <- Task.io $ Stuff.getPackageCache

64− manager <- Task.io $ Http.getManager

65− registry <- Task.eio Exit.BumpMustHaveLatestRegistry $ Registry.latest manager cache

66− outline <- Task.eio Exit.BumpBadOutline $ Outline.read root

67− case outline of

68− Outline.App _ ->

69− Task.throw Exit.BumpApplication

70−

71− Outline.Pkg pkgOutline ->

72− return $ Env root cache manager registry pkgOutline

73−

74−

75−

76−-- BUMP

77−

78−

79−bump :: Env -> Task.Task Exit.Bump ()

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

92−

93− Nothing ->

94− Task.io $ checkNewPackage root outline

95−

96−

97−

98−-- CHECK NEW PACKAGE

99−

100−

101−checkNewPackage :: FilePath -> Outline.PkgOutline -> IO ()

102−checkNewPackage root outline@(Outline.PkgOutline _ _ _ version _ _ _ _) =

103− do putStrLn Exit.newPackageOverview

104− if version == V.one

105− then

106− putStrLn "The version number in elm.json is correct so you are all set!"

107− else

108− changeVersion root outline V.one $

109− "It looks like the version in elm.json has been changed though!\n\

110− \Would you like me to change it back to "

111− <> D.fromVersion V.one <> "? [Y/n] "

112−

113−

114−

115−-- SUGGEST VERSION

116−

117−

118−suggestVersion :: Env -> Task.Task Exit.Bump ()

119−suggestVersion (Env root cache manager _ outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) =

120− do oldDocs <- Task.eio (Exit.BumpCannotFindDocs pkg vsn) (Diff.getDocs cache manager pkg vsn)

121− newDocs <- generateDocs root outline

122− let changes = Diff.diff oldDocs newDocs

123− let newVersion = Diff.bump changes vsn

124− Task.io $ changeVersion root outline newVersion $

125− let

126− old = D.fromVersion vsn

127− new = D.fromVersion newVersion

128− mag = D.fromChars $ M.toChars (Diff.toMagnitude changes)

129− in

130− "Based on your new API, this should be a" <+> D.green mag <+> "change (" <> old <> " => " <> new <> ")\n"

131− <> "Bail out of this command and run 'elm diff' for a full explanation.\n"

132− <> "\n"

133− <> "Should I perform the update (" <> old <> " => " <> new <> ") in elm.json? [Y/n] "

134−

135−

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−

151−

152−-- CHANGE VERSION

153−

154−

155−changeVersion :: FilePath -> Outline.PkgOutline -> V.Version -> D.Doc -> IO ()

156−changeVersion root outline targetVersion question =

157− do approved <- Reporting.ask question

158− if not approved

159− then

160− putStrLn "Okay, I did not change anything!"

161−

162− else

163− do Outline.write root $ Outline.Pkg $

164− outline { Outline._pkg_version = targetVersion }

165−

166− Help.toStdout $

167− "Version changed to "

168− <> D.green (D.fromVersion targetVersion)

169− <> "!\n"

terminal/src/Develop.hs+77−70

@@ -7,31 +7,27 @@ module Develop

9import Control.Applicative ((<|>))

10−import Control.Monad (guard)

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

11+import Control.Monad (guard, void)

11import Control.Monad.Trans (MonadIO(liftIO))

12import Control.Monad.Trans (MonadIO(liftIO))

12import qualified Data.ByteString.Builder as B

13import qualified Data.ByteString.Builder as B

13import qualified Data.ByteString as BS

14import qualified Data.ByteString as BS

14import qualified Data.HashMap.Strict as HashMap

15import qualified Data.HashMap.Strict as HashMap

15import Data.Monoid ((<>))

16import Data.Monoid ((<>))

16−import qualified Data.NonEmptyList as NE

17import qualified System.Directory as Dir

18import System.FilePath as FP

19−import Snap.Core hiding (path)

19+import Snap.Core

20import Snap.Http.Server

21import Snap.Util.FileServe

23−import qualified BackgroundWriter as BW

23+import qualified Elm.Project as Project

24−import qualified Build

24+import qualified Develop.Generate.Help as Generate

25−import qualified Elm.Details as Details

26−import qualified Develop.Generate.Help as Help

27import qualified Develop.Generate.Index as Index

25import qualified Develop.Generate.Index as Index

28import qualified Develop.StaticFiles as StaticFiles

26import qualified Develop.StaticFiles as StaticFiles

29−import qualified Generate.Html as Html

27+import qualified Generate.Output as Output

30−import qualified Generate

31−import qualified Reporting

32import qualified Reporting.Exit as Exit

28import qualified Reporting.Exit as Exit

29+import qualified Reporting.Progress as Progress

33import qualified Reporting.Task as Task

30import qualified Reporting.Task as Task

34−import qualified Stuff

@@ -46,19 +42,31 @@ data Flags =

47run :: () -> Flags -> IO ()

43run :: () -> Flags -> IO ()

48run () (Flags maybePort) =

44run () (Flags maybePort) =

49− do let port = maybe 8000 id maybePort

45+ let

50− putStrLn $ "Go to http://localhost:" ++ show port ++ " to see your project dashboard."

46+ port =

51− httpServe (config port) $

47+ maybe 8000 id maybePort

52− serveFiles

48+ in

53− <|> serveDirectoryWith directoryConfig "."

49+ do putStrLn $ "Go to <http://localhost:" ++ show port ++ "> to see your project dashboard."

54− <|> serveAssets

50+

55− <|> error404

51+ httpServe (config port) $

52+ serveFiles

53+ <|> serveDirectoryWith directoryConfig "."

54+ <|> serveAssets

55+ <|> error404

58config :: Int -> Config Snap a

59config port =

60− setVerbose False $ setPort port $

60+ defaultConfig

61− setAccessLog ConfigNoLog $ setErrorLog ConfigNoLog $ 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

@@ -67,12 +75,18 @@ config port =

68directoryConfig :: MonadSnap m => DirectoryConfig m

76directoryConfig :: MonadSnap m => DirectoryConfig m

69directoryConfig =

77directoryConfig =

70− fancyDirectoryConfig

78+ let

71− { indexFiles = []

79+ customGenerator pwd =

72− , indexGenerator = \pwd ->

80+ do modifyResponse $ setContentType "text/html; charset=utf-8"

73− do modifyResponse $ setContentType "text/html;charset=utf-8"

81+ html <- liftIO $

74− writeBuilder =<< liftIO (Index.generate pwd)

82+ do root <- Dir.getCurrentDirectory

75− }

83+ Index.get root pwd

84+ writeBuilder html

85+ in

86+ fancyDirectoryConfig

87+ { indexFiles = []

88+ , indexGenerator = customGenerator

89+ }

@@ -82,8 +96,8 @@ directoryConfig =

82error404 :: Snap ()

96error404 :: Snap ()

83error404 =

97error404 =

84 do modifyResponse $ setResponseStatus 404 "Not Found"

98 do modifyResponse $ setResponseStatus 404 "Not Found"

85− modifyResponse $ setContentType "text/html;charset=utf-8"

99+ modifyResponse $ setContentType "text/html; charset=utf-8"

86− writeBuilder $ Help.makePageHtml "NotFound" Nothing

100+ writeBuilder $ Generate.makePageHtml "NotFound" Nothing

101

102

103

@@ -92,9 +106,9 @@ error404 =

106

93serveFiles :: Snap ()

107serveFiles :: Snap ()

94serveFiles =

108serveFiles =

95− do path <- getSafePath

109+ do file <- getSafePath

96− guard =<< liftIO (Dir.doesFileExist path)

110+ guard =<< liftIO (Dir.doesFileExist file)

97− serveElm path <|> serveFilePretty path

111+ serveElm file <|> serveFilePretty file

112

113

100

114

@@ -102,33 +116,34 @@ serveFiles =

102

116

103

117

104serveFilePretty :: FilePath -> Snap ()

118serveFilePretty :: FilePath -> Snap ()

105−serveFilePretty path =

119+serveFilePretty file =

106 let

120 let

107 possibleExtensions =

121 possibleExtensions =

108− getSubExts (takeExtensions path)

122+ getSubExts (takeExtensions file)

109 in

123 in

110 case mconcat (map lookupMimeType possibleExtensions) of

124 case mconcat (map lookupMimeType possibleExtensions) of

111 Nothing ->

125 Nothing ->

112− serveCode path

126+ serveCode file

113

127

114 Just mimeType ->

128 Just mimeType ->

115− serveFileAs mimeType path

129+ serveFileAs mimeType file

116

130

117

131

118getSubExts :: String -> [String]

132getSubExts :: String -> [String]

119getSubExts fullExtension =

133getSubExts fullExtension =

120 if null fullExtension then

134 if null fullExtension then

121 []

135 []

136+

122 else

137 else

123 fullExtension : getSubExts (takeExtensions (drop 1 fullExtension))

138 fullExtension : getSubExts (takeExtensions (drop 1 fullExtension))

124

139

125

140

126serveCode :: String -> Snap ()

141serveCode :: String -> Snap ()

127−serveCode path =

142+serveCode file =

128− do code <- liftIO (BS.readFile path)

143+ do code <- liftIO (BS.readFile file)

129 modifyResponse (setContentType "text/html")

144 modifyResponse (setContentType "text/html")

130 writeBuilder $

145 writeBuilder $

131− Help.makeCodeHtml ('~' : '/' : path) (B.byteString code)

146+ Generate.makeCodeHtml ('~' : '/' : file) (B.byteString code)

132

147

133

148

134

149

@@ -136,33 +151,31 @@ serveCode path =

136

151

137

152

138serveElm :: FilePath -> Snap ()

153serveElm :: FilePath -> Snap ()

139−serveElm path =

154+serveElm file =

140− do guard (takeExtension path == ".elm")

155+ do guard (takeExtension file == ".elm")

141 modifyResponse (setContentType "text/html")

156 modifyResponse (setContentType "text/html")

142− result <- liftIO $ compile path

157+ writeBuilder =<< liftIO (compileToHtmlBuilder file)

143− case result of

144− Right builder ->

145− writeBuilder builder

146

158

147− Left exit ->

148− writeBuilder $ Help.makePageHtml "Errors" $ Just $

149− Exit.toJson $ Exit.reactorToReport exit

150

159

160+compileToHtmlBuilder :: FilePath -> IO B.Builder

161+compileToHtmlBuilder file =

162+ do mvar1 <- newEmptyMVar

163+ mvar2 <- newEmptyMVar

151

164

152−compile :: FilePath -> IO (Either Exit.Reactor B.Builder)

165+ let reporter = Progress.Reporter (\_ -> return ()) (\_ -> return True) (putMVar mvar1)

153−compile path =

166+ let output = Just (Output.HtmlBuilder mvar2)

154− do maybeRoot <- Stuff.findRoot

167+

155− case maybeRoot of

168+ void $ Task.try reporter $

156− Nothing ->

169+ do summary <- Project.getRoot

157− return $ Left $ Exit.ReactorNoOutline

170+ Project.compile Output.Dev Output.Client output summary [file]

158

171

159− Just root ->

172+ result <- takeMVar mvar1

160− BW.withScope $ \scope -> Stuff.withRootLock root $ Task.run $

173+ case result of

161− do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root

174+ Just exit ->

162− artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details (NE.List path [])

175+ return $ Generate.makePageHtml "Errors" (Just (Exit.toJson exit))

163− javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.dev root details artifacts

176+

164− let (NE.List name _) = Build.getRootNames artifacts

177+ Nothing ->

165− return $ Html.sandwich name javascript

178+ takeMVar mvar2

166

179

167

180

168

181

@@ -171,8 +184,8 @@ compile path =

171

184

172serveAssets :: Snap ()

185serveAssets :: Snap ()

173serveAssets =

186serveAssets =

174− do path <- getSafePath

187+ do file <- getSafePath

175− case StaticFiles.lookup path of

188+ case StaticFiles.lookup file of

176 Nothing ->

189 Nothing ->

177 pass

190 pass

178

191

@@ -218,16 +231,13 @@ mimeTypeDict =

218 , ".m3u" ==> "audio/x-mpegurl"

231 , ".m3u" ==> "audio/x-mpegurl"

219 , ".mov" ==> "video/quicktime"

232 , ".mov" ==> "video/quicktime"

220 , ".mp3" ==> "audio/mpeg"

233 , ".mp3" ==> "audio/mpeg"

221− , ".mp4" ==> "video/mp4"

222 , ".mpeg" ==> "video/mpeg"

234 , ".mpeg" ==> "video/mpeg"

223 , ".mpg" ==> "video/mpeg"

235 , ".mpg" ==> "video/mpeg"

224 , ".ogg" ==> "application/ogg"

236 , ".ogg" ==> "application/ogg"

225− , ".otf" ==> "font/otf"

226 , ".pac" ==> "application/x-ns-proxy-autoconfig"

237 , ".pac" ==> "application/x-ns-proxy-autoconfig"

227 , ".pdf" ==> "application/pdf"

238 , ".pdf" ==> "application/pdf"

228 , ".png" ==> "image/png"

239 , ".png" ==> "image/png"

229 , ".qt" ==> "video/quicktime"

240 , ".qt" ==> "video/quicktime"

230− , ".sfnt" ==> "font/sfnt"

231 , ".sig" ==> "application/pgp-signature"

241 , ".sig" ==> "application/pgp-signature"

232 , ".spl" ==> "application/futuresplash"

242 , ".spl" ==> "application/futuresplash"

233 , ".svg" ==> "image/svg+xml"

243 , ".svg" ==> "image/svg+xml"

@@ -238,19 +248,16 @@ mimeTypeDict =

238 , ".tbz" ==> "application/x-bzip-compressed-tar"

248 , ".tbz" ==> "application/x-bzip-compressed-tar"

239 , ".text" ==> "text/plain"

249 , ".text" ==> "text/plain"

240 , ".tgz" ==> "application/x-tgz"

250 , ".tgz" ==> "application/x-tgz"

241− , ".ttf" ==> "font/ttf"

251+ , ".ttf" ==> "application/x-font-truetype"

242 , ".txt" ==> "text/plain"

252 , ".txt" ==> "text/plain"

243 , ".wav" ==> "audio/x-wav"

253 , ".wav" ==> "audio/x-wav"

244 , ".wax" ==> "audio/x-ms-wax"

254 , ".wax" ==> "audio/x-ms-wax"

245− , ".webm" ==> "video/webm"

246− , ".webp" ==> "image/webp"

247 , ".wma" ==> "audio/x-ms-wma"

255 , ".wma" ==> "audio/x-ms-wma"

248 , ".wmv" ==> "video/x-ms-wmv"

256 , ".wmv" ==> "video/x-ms-wmv"

249− , ".woff" ==> "font/woff"

250− , ".woff2" ==> "font/woff2"

251 , ".xbm" ==> "image/x-xbitmap"

257 , ".xbm" ==> "image/x-xbitmap"

252 , ".xml" ==> "text/xml"

258 , ".xml" ==> "text/xml"

253 , ".xpm" ==> "image/x-xpixmap"

259 , ".xpm" ==> "image/x-xpixmap"

254 , ".xwd" ==> "image/x-xwindowdump"

260 , ".xwd" ==> "image/x-xwindowdump"

255 , ".zip" ==> "application/zip"

261 , ".zip" ==> "application/zip"

256 ]

262 ]

263+

terminal/src/Develop/Generate/Index.hs+74−149

@@ -1,37 +1,36 @@

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

3module Develop.Generate.Index

4− ( generate

4+ ( get

5 )

6 where

9import Control.Monad (filterM)

10import qualified Data.ByteString.Builder as B

11−import qualified Data.List as List

12import qualified Data.Map as Map

11import qualified Data.Map as Map

12+import qualified Data.Text as Text

13+import qualified Data.Text.IO as Text

13import qualified System.Directory as Dir

14import qualified System.Directory as Dir

14import System.FilePath ((</>), splitDirectories, takeExtension)

15import System.FilePath ((</>), splitDirectories, takeExtension)

16−import qualified BackgroundWriter as BW

17import qualified Develop.Generate.Help as Help

18−import qualified Elm.Details as Details

19−import qualified Elm.Outline as Outline

20import qualified Elm.Package as Pkg

18import qualified Elm.Package as Pkg

21−import qualified Elm.Version as V

19+import qualified Elm.Project.Json as Project

20+import qualified Elm.Project.Summary as Summary

22import qualified Json.Encode as E

21import qualified Json.Encode as E

23−import Json.Encode ((==>))

22+import qualified Reporting.Progress as Progress

24−import qualified Reporting

23+import qualified Reporting.Task as Task

25−import qualified Stuff

24+import qualified Stuff.Verify as Verify

29−-- GENERATE

28+-- GET

32−generate :: FilePath -> IO B.Builder

31+get :: FilePath -> FilePath -> IO B.Builder

33−generate pwd =

32+get root pwd =

34− do flags <- getFlags pwd

33+ do flags <- getFlags root pwd

35 return $ Help.makePageHtml "Index" (Just (encode flags))

34 return $ Help.makePageHtml "Index" (Just (encode flags))

@@ -44,33 +43,60 @@ data Flags =

44 { _root :: FilePath

43 { _root :: FilePath

45 , _pwd :: [String]

44 , _pwd :: [String]

46 , _dirs :: [FilePath]

45 , _dirs :: [FilePath]

47− , _files :: [File]

46+ , _files :: [(FilePath, Bool)]

48− , _readme :: Maybe String

47+ , _readme :: Maybe Text.Text

49− , _outline :: Maybe Outline.Outline

48+ , _project :: Maybe Project.Project

50− , _exactDeps :: Map.Map Pkg.Name V.Version

49+ , _exactDeps :: Map.Map Pkg.Name Pkg.Version

51 }

50 }

54−data File =

53+

55− File

54+-- JSON

56− { _path :: FilePath

55+

57− , _runnable :: Bool

56+

58− }

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

62-- GET FLAGS

84-- GET FLAGS

65−getFlags :: FilePath -> IO Flags

87+getFlags :: FilePath -> FilePath -> IO Flags

66−getFlags pwd =

88+getFlags root pwd =

67− do contents <- Dir.getDirectoryContents pwd

89+ do (dirs, files) <- getDirsAndFiles pwd

68− root <- Dir.getCurrentDirectory

69− dirs <- getDirs pwd contents

70− files <- getFiles pwd contents

71 readme <- getReadme pwd

90 readme <- getReadme pwd

72− outline <- getOutline

91+ exists <- Dir.doesFileExist (root </> "elm.json")

73− exactDeps <- getExactDeps outline

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+

74 return $

100 return $

75 Flags

101 Flags

76 { _root = root

102 { _root = root

@@ -78,136 +104,35 @@ getFlags pwd =

78 , _dirs = dirs

104 , _dirs = dirs

79 , _files = files

105 , _files = files

80 , _readme = readme

106 , _readme = readme

81− , _outline = outline

107+ , _project = fmap Summary._project maybeSummary

82− , _exactDeps = exactDeps

108+ , _exactDeps = maybe Map.empty (Map.map fst . Summary._depsGraph) maybeSummary

83 }

109 }

110

111

86−

112+getReadme :: FilePath -> IO (Maybe Text.Text)

87−-- README

88−

89−

90−getReadme :: FilePath -> IO (Maybe String)

91getReadme dir =

113getReadme dir =

92 do let readmePath = dir </> "README.md"

114 do let readmePath = dir </> "README.md"

93 exists <- Dir.doesFileExist readmePath

115 exists <- Dir.doesFileExist readmePath

94 if exists

116 if exists

95− then Just <$> readFile readmePath

117+ then Just <$> Text.readFile readmePath

96 else return Nothing

118 else return Nothing

119

120

99−

121+getDirsAndFiles :: FilePath -> IO ([FilePath], [(FilePath, Bool)])

100−-- GET DIRECTORIES

122+getDirsAndFiles pwd =

101−

123+ do contents <- Dir.getDirectoryContents pwd

102−

124+ dirs <- filterM (Dir.doesDirectoryExist . (pwd </>)) contents

103−getDirs :: FilePath -> [FilePath] -> IO [FilePath]

125+ filePaths <- filterM (Dir.doesFileExist . (pwd </>)) contents

104−getDirs pwd contents =

126+ files <- mapM (inspectFile pwd) filePaths

105− filterM (Dir.doesDirectoryExist . (pwd </>)) contents

127+ return (dirs, files)

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

128

117

129

118−toFile :: FilePath -> FilePath -> IO File

130+inspectFile :: FilePath -> FilePath -> IO (FilePath, Bool)

119−toFile pwd path =

131+inspectFile pwd path =

120 if takeExtension path == ".elm" then

132 if takeExtension path == ".elm" then

121− do source <- readFile (pwd </> path)

133+ do source <- Text.readFile (pwd </> path)

122− let hasMain = List.isInfixOf "\nmain " source

134+ let hasMain = Text.isInfixOf "\nmain " source

123− return (File path hasMain)

135+ return (path, hasMain)

124− else

125− return (File path False)

126−

127

136

128−

137+ else

129−-- GET OUTLINE

138+ return (path, False)

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

@@ -36,6 +36,7 @@ dict :: HM.HashMap FilePath (BS.ByteString, MimeType)

36dict =

37 HM.fromList

38 [ faviconPath ==> (favicon , "image/x-icon")

39+ , waitingPath ==> (waiting , "image/gif")

39 , elmPath ==> (elm , "application/javascript")

40 , elmPath ==> (elm , "application/javascript")

40 , cssPath ==> (css , "text/css")

41 , cssPath ==> (css , "text/css")

41 , codeFontPath ==> (codeFont, "font/ttf")

42 , codeFontPath ==> (codeFont, "font/ttf")

@@ -88,7 +89,7 @@ sansFontPath =

89elm :: BS.ByteString

90elm :: BS.ByteString

90elm =

91elm =

91− $(bsToExp =<< runIO Build.buildReactorFrontEnd)

92+ $(bsToExp =<< runIO Build.compile)

@@ -121,3 +122,8 @@ sansFont =

121favicon :: BS.ByteString

122favicon :: BS.ByteString

122favicon =

123favicon =

123 $(bsToExp =<< runIO (Build.readAsset "favicon.ico"))

124 $(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+29−46

@@ -1,25 +1,19 @@

1{-# LANGUAGE OverloadedStrings #-}

2module Develop.StaticFiles.Build

3 ( readAsset

4− , buildReactorFrontEnd

4+ , compile

5 )

6 where

9import 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

13import qualified System.Directory as Dir

10import qualified System.Directory as Dir

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

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

16−import qualified BackgroundWriter as BW

13+import qualified Elm.Project as Project

17−import qualified Build

14+import qualified Generate.Output as Output

18−import qualified Elm.Details as Details

19−import qualified Generate

20−import qualified Reporting

21−import qualified Reporting.Exit as Exit

22import qualified Reporting.Task as Task

15import qualified Reporting.Task as Task

16+import qualified Reporting.Progress.Terminal as Terminal

@@ -32,42 +26,31 @@ readAsset path =

35−-- BUILD REACTOR ELM

29+-- COMPILE

38−buildReactorFrontEnd :: IO BS.ByteString

32+compile :: IO BS.ByteString

39−buildReactorFrontEnd =

33+compile =

40− BW.withScope $ \scope ->

41 Dir.withCurrentDirectory "reactor" $

34 Dir.withCurrentDirectory "reactor" $

42− do root <- Dir.getCurrentDirectory

35+ do reporter <- Terminal.create

43− runTaskUnsafe $

36+ Task.run reporter $

44− do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root

37+ do summary <- Project.getRoot

45− artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details paths

38+ let jsOutput = Just (Output.JavaScript Nothing tempFileName)

46− javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.prod root details artifacts

39+ Project.compile Output.Prod Output.Client jsOutput summary rootPaths

47− return (LBS.toStrict (B.toLazyByteString javascript))

40+

48−

41+ result <- BS.readFile tempFileName

49−

42+ seq (BS.length result) (Dir.removeFile tempFileName)

50−paths :: NE.List FilePath

43+ return result

51−paths =

44+

52− NE.List

45+

53− ("src" </> "NotFound.elm")

46+tempFileName :: FilePath

54− [ "src" </> "Errors.elm"

47+tempFileName =

55− , "src" </> "Index.elm"

48+ "elm.js"

56− ]

49+

57−

50+

58−

51+rootPaths :: [FilePath]

59−runTaskUnsafe :: Task.Task Exit.Reactor a -> IO a

52+rootPaths =

60−runTaskUnsafe task =

53+ [ "src" </> "Errors.elm"

61− do result <- Task.run task

54+ , "src" </> "Index.elm"

62− case result of

55+ , "src" </> "NotFound.elm"

63− Right a ->

56+ ]

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+6−348

@@ -1,359 +1,17 @@

1{-# OPTIONS_GHC -Wall #-}

2−{-# LANGUAGE OverloadedStrings #-}

2+module Diff (run) where

3−module Diff

4− ( Args(..)

5− , run

6− )

7− where

10−import qualified Data.List as List

5+import qualified Elm.Diff as Diff

11−import qualified Data.Map as Map

12−import qualified Data.Maybe as Maybe

13−import qualified Data.Name as Name

14−import qualified Data.NonEmptyList as NE

15−

16−import qualified BackgroundWriter as BW

17−import qualified Build

18−import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..))

19−import qualified Deps.Diff as DD

20−import qualified Deps.Registry as Registry

21−import qualified Elm.Compiler.Type as Type

22−import qualified Elm.Details as Details

23−import qualified Elm.Docs as Docs

24−import qualified Elm.Magnitude as M

25−import qualified Elm.Outline as Outline

26−import qualified Elm.Package as Pkg

27−import qualified Elm.Version as V

28−import qualified Http

29−import qualified Reporting

30−import Reporting.Doc ((<>), (<+>))

31−import qualified Reporting.Doc as D

32−import qualified Reporting.Exit as Exit

33−import qualified Reporting.Exit.Help as Help

34−import qualified Reporting.Render.Type.Localizer as L

35import qualified Reporting.Task as Task

6import qualified Reporting.Task as Task

36−import qualified Stuff

7+import qualified Reporting.Progress.Terminal as Terminal

40-- RUN

11-- RUN

43−data Args

14+run :: Diff.Args -> () -> IO ()

44− = CodeVsLatest

45− | CodeVsExactly V.Version

46− | LocalInquiry V.Version V.Version

47− | GlobalInquiry Pkg.Name V.Version V.Version

48−

49−

50−run :: Args -> () -> IO ()

51run args () =

15run args () =

52− Reporting.attempt Exit.diffToReport $

16+ do reporter <- Terminal.create

53− Task.run $

17+ Task.run reporter $ Diff.diff args

54− do env <- getEnv

55− diff env args

56−

57−

58−

59−-- ENVIRONMENT

60−

61−

62−data Env =

63− Env

64− { _maybeRoot :: Maybe FilePath

65− , _cache :: Stuff.PackageCache

66− , _manager :: Http.Manager

67− , _registry :: Registry.Registry

68− }

69−

70−

71−getEnv :: Task Env

72−getEnv =

73− do maybeRoot <- Task.io $ Stuff.findRoot

74− cache <- Task.io $ Stuff.getPackageCache

75− manager <- Task.io $ Http.getManager

76− registry <- Task.eio Exit.DiffMustHaveLatestRegistry $ Registry.latest manager cache

77− return (Env maybeRoot cache manager registry)

78−

79−

80−

81−-- DIFF

82−

83−

84−type Task a =

85− Task.Task Exit.Diff a

86−

87−

88−diff :: Env -> Args -> Task ()

89−diff env@(Env _ _ _ registry) args =

90− case args of

91− GlobalInquiry name v1 v2 ->

92− case Registry.getVersions' name registry of

93− Right vsns ->

94− do oldDocs <- getDocs env name vsns (min v1 v2)

95− newDocs <- getDocs env name vsns (max v1 v2)

96− writeDiff oldDocs newDocs

97−

98− Left suggestions ->

99− Task.throw $ Exit.DiffUnknownPackage name suggestions

100−

101− LocalInquiry v1 v2 ->

102− do (name, vsns) <- readOutline env

103− oldDocs <- getDocs env name vsns (min v1 v2)

104− newDocs <- getDocs env name vsns (max v1 v2)

105− writeDiff oldDocs newDocs

106−

107− CodeVsLatest ->

108− do (name, vsns) <- readOutline env

109− oldDocs <- getLatestDocs env name vsns

110− newDocs <- generateDocs env

111− writeDiff oldDocs newDocs

112−

113− CodeVsExactly version ->

114− do (name, vsns) <- readOutline env

115− oldDocs <- getDocs env name vsns version

116− newDocs <- generateDocs env

117− writeDiff oldDocs newDocs

118−

119−

120−

121−-- GET DOCS

122−

123−

124−getDocs :: Env -> Pkg.Name -> Registry.KnownVersions -> V.Version -> Task Docs.Documentation

125−getDocs (Env _ cache manager _) name (Registry.KnownVersions latest previous) version =

126− if latest == version || elem version previous

127− then Task.eio (Exit.DiffDocsProblem version) $ DD.getDocs cache manager name version

128− else Task.throw $ Exit.DiffUnknownVersion name version (latest:previous)

129−

130−

131−getLatestDocs :: Env -> Pkg.Name -> Registry.KnownVersions -> Task Docs.Documentation

132−getLatestDocs (Env _ cache manager _) name (Registry.KnownVersions latest _) =

133− Task.eio (Exit.DiffDocsProblem latest) $ DD.getDocs cache manager name latest

134−

135−

136−

137−-- READ OUTLINE

138−

139−

140−readOutline :: Env -> Task (Pkg.Name, Registry.KnownVersions)

141−readOutline (Env maybeRoot _ _ registry) =

142− case maybeRoot of

143− Nothing ->

144− Task.throw $ Exit.DiffNoOutline

145−

146− Just root ->

147− do result <- Task.io $ Outline.read root

148− case result of

149− Left err ->

150− Task.throw $ Exit.DiffBadOutline err

151−

152− Right outline ->

153− case outline of

154− Outline.App _ ->

155− Task.throw $ Exit.DiffApplication

156−

157− Outline.Pkg (Outline.PkgOutline pkg _ _ _ _ _ _ _) ->

158− case Registry.getVersions pkg registry of

159− Just vsns -> return (pkg, vsns)

160− Nothing -> Task.throw Exit.DiffUnpublished

161−

162−

163−

164−-- GENERATE DOCS

165−

166−

167−generateDocs :: Env -> Task Docs.Documentation

168−generateDocs (Env maybeRoot _ _ _) =

169− case maybeRoot of

170− Nothing ->

171− Task.throw $ Exit.DiffNoOutline

172−

173− Just root ->

174− do details <-

175− Task.eio Exit.DiffBadDetails $ BW.withScope $ \scope ->

176− Details.load Reporting.silent scope root

177−

178− case Details._outline details of

179− Details.ValidApp _ ->

180− Task.throw $ Exit.DiffApplication

181−

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)

190−

191−

192−

193−-- WRITE DIFF

194−

195−

196−writeDiff :: Docs.Documentation -> Docs.Documentation -> Task ()

197−writeDiff oldDocs newDocs =

198− let

199− changes = DD.diff oldDocs newDocs

200− localizer = L.fromNames (Map.union oldDocs newDocs)

201− in

202− Task.io $ Help.toStdout $ toDoc localizer changes <> "\n"

203−

204−

205−

206−-- TO DOC

207−

208−

209−toDoc :: L.Localizer -> PackageChanges -> D.Doc

210−toDoc localizer changes@(PackageChanges added changed removed) =

211− if null added && Map.null changed && null removed then

212− "No API changes detected, so this is a" <+> D.green "PATCH" <+> "change."

213− else

214− let

215− magDoc =

216− D.fromChars (M.toChars (DD.toMagnitude changes))

217−

218− header =

219− "This is a" <+> D.green magDoc <+> "change."

220−

221− addedChunk =

222− if null added then [] else

223− [ Chunk "ADDED MODULES" M.MINOR $

224− D.vcat $ map D.fromName added

225− ]

226−

227− removedChunk =

228− if null removed then [] else

229− [ Chunk "REMOVED MODULES" M.MAJOR $

230− D.vcat $ map D.fromName removed

231− ]

232−

233− chunks =

234− addedChunk ++ removedChunk ++ map (changesToChunk localizer) (Map.toList changed)

235− in

236− D.vcat (header : "" : map chunkToDoc chunks)

237−

238−

239−data Chunk =

240− Chunk

241− { _title :: String

242− , _magnitude :: M.Magnitude

243− , _details :: D.Doc

244− }

245−

246−

247−chunkToDoc :: Chunk -> D.Doc

248−chunkToDoc (Chunk title magnitude details) =

249− let

250− header =

251− "----" <+> D.fromChars title <+> "-" <+> D.fromChars (M.toChars magnitude) <+> "----"

252− in

253− D.vcat

254− [ D.dullcyan header

255− , ""

256− , D.indent 4 details

257− , ""

258− , ""

259− ]

260−

261−

262−changesToChunk :: L.Localizer -> (Name.Name, ModuleChanges) -> Chunk

263−changesToChunk localizer (name, changes@(ModuleChanges unions aliases values binops)) =

264− let

265− magnitude =

266− DD.moduleChangeMagnitude changes

267−

268− (unionAdd, unionChange, unionRemove) =

269− changesToDocTriple (unionToDoc localizer) unions

270−

271− (aliasAdd, aliasChange, aliasRemove) =

272− changesToDocTriple (aliasToDoc localizer) aliases

273−

274− (valueAdd, valueChange, valueRemove) =

275− changesToDocTriple (valueToDoc localizer) values

276−

277− (binopAdd, binopChange, binopRemove) =

278− changesToDocTriple (binopToDoc localizer) binops

279− in

280− Chunk (Name.toChars name) magnitude $

281− D.vcat $ List.intersperse "" $ Maybe.catMaybes $

282− [ changesToDoc "Added" unionAdd aliasAdd valueAdd binopAdd

283− , changesToDoc "Removed" unionRemove aliasRemove valueRemove binopRemove

284− , changesToDoc "Changed" unionChange aliasChange valueChange binopChange

285− ]

286−

287−

288−changesToDocTriple :: (k -> v -> D.Doc) -> Changes k v -> ([D.Doc], [D.Doc], [D.Doc])

289−changesToDocTriple entryToDoc (Changes added changed removed) =

290− let

291− indented (name, value) =

292− D.indent 4 (entryToDoc name value)

293−

294− diffed (name, (oldValue, newValue)) =

295− D.vcat

296− [ " - " <> entryToDoc name oldValue

297− , " + " <> entryToDoc name newValue

298− , ""

299− ]

300− in

301− ( map indented (Map.toList added)

302− , map diffed (Map.toList changed)

303− , map indented (Map.toList removed)

304− )

305−

306−

307−changesToDoc :: String -> [D.Doc] -> [D.Doc] -> [D.Doc] -> [D.Doc] -> Maybe D.Doc

308−changesToDoc categoryName unions aliases values binops =

309− if null unions && null aliases && null values && null binops then

310− Nothing

311−

312− else

313− Just $ D.vcat $

314− D.fromChars categoryName <> ":" : unions ++ aliases ++ binops ++ values

315−

316−

317−unionToDoc :: L.Localizer -> Name.Name -> Docs.Union -> D.Doc

318−unionToDoc localizer name (Docs.Union _ tvars ctors) =

319− let

320− setup =

321− "type" <+> D.fromName name <+> D.hsep (map D.fromName tvars)

322−

323− ctorDoc (ctor, tipes) =

324− typeDoc localizer (Type.Type ctor tipes)

325− in

326− D.hang 4 (D.sep (setup : zipWith (<+>) ("=" : repeat "|") (map ctorDoc ctors)))

327−

328−

329−aliasToDoc :: L.Localizer -> Name.Name -> Docs.Alias -> D.Doc

330−aliasToDoc localizer name (Docs.Alias _ tvars tipe) =

331− let

332− declaration =

333− "type" <+> "alias" <+> D.hsep (map D.fromName (name:tvars)) <+> "="

334− in

335− D.hang 4 (D.sep [ declaration, typeDoc localizer tipe ])

336−

337−

338−valueToDoc :: L.Localizer -> Name.Name -> Docs.Value -> D.Doc

339−valueToDoc localizer name (Docs.Value _ tipe) =

340− D.hang 4 $ D.sep [ D.fromName name <+> ":", typeDoc localizer tipe ]

341−

342−

343−binopToDoc :: L.Localizer -> Name.Name -> Docs.Binop -> D.Doc

344−binopToDoc localizer name (Docs.Binop _ tipe associativity (Docs.Precedence n)) =

345− "(" <> D.fromName name <> ")" <+> ":" <+> typeDoc localizer tipe <> D.black details

346− where

347− details =

348− " (" <> D.fromName assoc <> "/" <> D.fromInt n <> ")"

349−

350− assoc =

351− case associativity of

352− Docs.Left -> "left"

353− Docs.Non -> "non"

354− Docs.Right -> "right"

355−

356−

357−typeDoc :: L.Localizer -> Type.Type -> D.Doc

358−typeDoc localizer tipe =

359− Type.toDoc localizer Type.None tipe

terminal/src/Init.hs+1−1

@@ -90,7 +90,7 @@ init =

90 in

91 do Dir.createDirectoryIfMissing True "src"

92 Outline.write "." $ Outline.App $

93− Outline.AppOutline V.compiler (NE.List (Outline.RelativeSrcDir "src") []) directs indirects Map.empty Map.empty

93+ Outline.AppOutline V.compiler (NE.List "src" []) directs indirects Map.empty Map.empty

94 putStrLn "Okay, I created it. Now read that link!"

95 return (Right ())

terminal/src/Install.hs+31−16

@@ -10,7 +10,6 @@ import Data.Map ((!))

10import qualified Data.Map as Map

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

13−import qualified BackgroundWriter as BW

14import qualified Deps.Solver as Solver

13import qualified Deps.Solver as Solver

15import qualified Deps.Registry as Registry

14import qualified Deps.Registry as Registry

16import qualified Elm.Constraint as C

15import qualified Elm.Constraint as C

@@ -41,7 +40,7 @@ run args () =

41 do maybeRoot <- Stuff.findRoot

40 do maybeRoot <- Stuff.findRoot

42 case maybeRoot of

41 case maybeRoot of

43 Nothing ->

42 Nothing ->

44− return (Left Exit.InstallNoOutline)

43+ return (Left Exit.InstallNoProject)

46 Just root ->

45 Just root ->

47 case args of

46 case args of

@@ -51,8 +50,8 @@ run args () =

52 Install pkg ->

51 Install pkg ->

53 Task.run $

52 Task.run $

54− do env <- Task.eio Exit.InstallBadRegistry $ Solver.initEnv

53+ do env <- getEnv

55− oldOutline <- Task.eio Exit.InstallBadOutline $ Outline.read root

54+ oldOutline <- getOutline root

56 case oldOutline of

55 case oldOutline of

57 Outline.App outline ->

56 Outline.App outline ->

58 do changes <- makeAppPlan env pkg outline

57 do changes <- makeAppPlan env pkg outline

@@ -64,6 +63,23 @@ run args () =

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+

67-- ATTEMPT CHANGES

83-- ATTEMPT CHANGES

@@ -124,13 +140,12 @@ attemptChanges root env oldOutline toChars changes =

124

140

125attemptChangesHelp :: FilePath -> Solver.Env -> Outline.Outline -> Outline.Outline -> D.Doc -> Task ()

141attemptChangesHelp :: FilePath -> Solver.Env -> Outline.Outline -> Outline.Outline -> D.Doc -> Task ()

126attemptChangesHelp root env oldOutline newOutline question =

142attemptChangesHelp root env oldOutline newOutline question =

127− Task.eio Exit.InstallBadDetails $

143+ Task.eio Exit.InstallHasBadDetails $

128− BW.withScope $ \scope ->

129 do approved <- Reporting.ask question

144 do approved <- Reporting.ask question

130 if approved

145 if approved

131 then

146 then

132 do Outline.write root newOutline

147 do Outline.write root newOutline

133− result <- Details.verifyInstall scope root env newOutline

148+ result <- Details.verifyInstall root env newOutline

134 case result of

149 case result of

135 Left exit ->

150 Left exit ->

136 do Outline.write root oldOutline

151 do Outline.write root oldOutline

@@ -188,8 +203,8 @@ makeAppPlan (Solver.Env cache _ connection registry) pkg outline@(Outline.AppOut

188 case Registry.getVersions' pkg registry of

203 case Registry.getVersions' pkg registry of

189 Left suggestions ->

204 Left suggestions ->

190 case connection of

205 case connection of

191− Solver.Online _ -> Task.throw (Exit.InstallUnknownPackageOnline pkg suggestions)

206+ Solver.Online _ -> Task.throw (Exit.InstallUnknownPackageOnline suggestions)

192− Solver.Offline -> Task.throw (Exit.InstallUnknownPackageOffline pkg suggestions)

207+ Solver.Offline -> Task.throw (Exit.InstallUnknownPackageOffline suggestions)

193

208

194 Right _ ->

209 Right _ ->

195 do result <- Task.io $ Solver.addToApp cache connection registry pkg outline

210 do result <- Task.io $ Solver.addToApp cache connection registry pkg outline

@@ -198,10 +213,10 @@ makeAppPlan (Solver.Env cache _ connection registry) pkg outline@(Outline.AppOut

198 return (Changes (detectChanges old new) (Outline.App app))

213 return (Changes (detectChanges old new) (Outline.App app))

199

214

200 Solver.NoSolution ->

215 Solver.NoSolution ->

201− Task.throw (Exit.InstallNoOnlineAppSolution pkg)

216+ Task.throw Exit.InstallNoOnlineSolution

202

217

203 Solver.NoOfflineSolution ->

218 Solver.NoOfflineSolution ->

204− Task.throw (Exit.InstallNoOfflineAppSolution pkg)

219+ Task.throw Exit.InstallNoOfflineSolution

205

220

206 Solver.Err exit ->

221 Solver.Err exit ->

207 Task.throw (Exit.InstallHadSolverTrouble exit)

222 Task.throw (Exit.InstallHadSolverTrouble exit)

@@ -230,8 +245,8 @@ makePkgPlan (Solver.Env cache _ connection registry) pkg outline@(Outline.PkgOut

230 case Registry.getVersions' pkg registry of

245 case Registry.getVersions' pkg registry of

231 Left suggestions ->

246 Left suggestions ->

232 case connection of

247 case connection of

233− Solver.Online _ -> Task.throw (Exit.InstallUnknownPackageOnline pkg suggestions)

248+ Solver.Online _ -> Task.throw (Exit.InstallUnknownPackageOnline suggestions)

234− Solver.Offline -> Task.throw (Exit.InstallUnknownPackageOffline pkg suggestions)

249+ Solver.Offline -> Task.throw (Exit.InstallUnknownPackageOffline suggestions)

235

250

236 Right (Registry.KnownVersions _ _) ->

251 Right (Registry.KnownVersions _ _) ->

237 do let old = Map.union deps test

252 do let old = Map.union deps test

@@ -254,10 +269,10 @@ makePkgPlan (Solver.Env cache _ connection registry) pkg outline@(Outline.PkgOut

254 }

269 }

255

270

256 Solver.NoSolution ->

271 Solver.NoSolution ->

257− Task.throw (Exit.InstallNoOnlinePkgSolution pkg)

272+ Task.throw Exit.InstallNoOnlineSolution

258

273

259 Solver.NoOfflineSolution ->

274 Solver.NoOfflineSolution ->

260− Task.throw (Exit.InstallNoOfflinePkgSolution pkg)

275+ Task.throw Exit.InstallNoOfflineSolution

261

276

262 Solver.Err exit ->

277 Solver.Err exit ->

263 Task.throw (Exit.InstallHadSolverTrouble exit)

278 Task.throw (Exit.InstallHadSolverTrouble exit)

@@ -385,7 +400,7 @@ viewRemove toChars (Widths nameWidth leftWidth _) name old =

385

400

386viewName :: Int -> Pkg.Name -> D.Doc

401viewName :: Int -> Pkg.Name -> D.Doc

387viewName width name =

402viewName width name =

388− D.fill (width + 3) (D.fromPackage name)

403+ D.fill (width + 3) (D.fromUtf8 (Pkg.toString name))

389

404

390

405

391pad :: Int -> String -> D.Doc

406pad :: Int -> String -> D.Doc

terminal/src/Main.hs+36−32

@@ -6,14 +6,17 @@ module Main

8import Prelude hiding (init)

9+import GHC.IO.Encoding (setLocaleEncoding, utf8)

9import qualified Data.List as List

10import qualified Data.List as List

10import qualified Text.PrettyPrint.ANSI.Leijen as P

11import qualified Text.PrettyPrint.ANSI.Leijen as P

11import Text.PrettyPrint.ANSI.Leijen ((<>))

12import Text.PrettyPrint.ANSI.Leijen ((<>))

12import Text.Read (readMaybe)

13import Text.Read (readMaybe)

15+import qualified Elm.Diff as Diff

14import qualified Elm.Version as V

16import qualified Elm.Version as V

15−import Terminal

17+import qualified Generate.Output as Output

16−import Terminal.Helpers

18+import Terminal.Args

19+import Terminal.Args.Helpers

18import qualified Bump

21import qualified Bump

19import qualified Develop

22import qualified Develop

@@ -31,16 +34,17 @@ import qualified Repl

32main :: IO ()

35main :: IO ()

33main =

36main =

34− Terminal.app intro outro

37+ do setLocaleEncoding utf8

35− [ repl

38+ complex intro outro

36− , init

39+ [ repl

37− , reactor

40+ , init

38− , make

41+ , reactor

39− , install

42+ , make

40− , bump

43+ , install

41− , diff

44+ , bump

42− , publish

45+ , diff

43− ]

46+ , publish

47+ ]

46intro :: P.Doc

50intro :: P.Doc

@@ -72,7 +76,7 @@ outro =

72-- INIT

76-- INIT

75−init :: Terminal.Command

79+init :: Interface

76init =

80init =

77 let

81 let

78 summary =

82 summary =

@@ -87,14 +91,14 @@ init =

87 "It will ask permission to create an elm.json file, the one thing common\

91 "It will ask permission to create an elm.json file, the one thing common\

88 \ to all Elm projects. It also provides a link explaining what to do from there."

92 \ to all Elm projects. It also provides a link explaining what to do from there."

89 in

93 in

90− Terminal.Command "init" (Common summary) details example noArgs noFlags Init.run

94+ Interface "init" (Common summary) details example noArgs noFlags Init.run

94-- REPL

98-- REPL

100

97−repl :: Terminal.Command

101+repl :: Interface

98repl =

102repl =

99 let

103 let

100 summary =

104 summary =

@@ -115,7 +119,7 @@ repl =

115 |-- flag "interpreter" interpreter "Path to a alternate JS interpreter, like node or nodejs."

119 |-- flag "interpreter" interpreter "Path to a alternate JS interpreter, like node or nodejs."

116 |-- onOff "no-colors" "Turn off the colors in the REPL. This can help if you are having trouble reading the values. Some terminals use a custom color scheme that diverges significantly from the standard ANSI colors, so another path may be to pick a more standard color scheme."

120 |-- onOff "no-colors" "Turn off the colors in the REPL. This can help if you are having trouble reading the values. Some terminals use a custom color scheme that diverges significantly from the standard ANSI colors, so another path may be to pick a more standard color scheme."

117 in

121 in

118− Terminal.Command "repl" (Common summary) details example noArgs replFlags Repl.run

122+ Interface "repl" (Common summary) details example noArgs replFlags Repl.run

119

123

120

124

121interpreter :: Parser String

125interpreter :: Parser String

@@ -133,7 +137,7 @@ interpreter =

133-- REACTOR

137-- REACTOR

134

138

135

139

136−reactor :: Terminal.Command

140+reactor :: Interface

137reactor =

141reactor =

138 let

142 let

139 summary =

143 summary =

@@ -154,7 +158,7 @@ reactor =

154 flags Develop.Flags

158 flags Develop.Flags

155 |-- flag "port" port_ "The port of the server (default: 8000)"

159 |-- flag "port" port_ "The port of the server (default: 8000)"

156 in

160 in

157− Terminal.Command "reactor" (Common summary) details example noArgs reactorFlags Develop.run

161+ Interface "reactor" (Common summary) details example noArgs reactorFlags Develop.run

158

162

159

163

160port_ :: Parser Int

164port_ :: Parser Int

@@ -172,7 +176,7 @@ port_ =

172-- MAKE

176-- MAKE

173

177

174

178

175−make :: Terminal.Command

179+make :: Interface

176make =

180make =

177 let

181 let

178 details =

182 details =

@@ -184,26 +188,26 @@ make =

184 "For example:"

188 "For example:"

185 , P.indent 4 $ P.green "elm make src/Main.elm"

189 , P.indent 4 $ P.green "elm make src/Main.elm"

186 , reflow

190 , reflow

187− "This tries to compile an Elm file named src/Main.elm, generating an index.html\

191+ "This tries to compile an Elm file named src/Main.elm, putting the resulting\

188− \ file if possible."

192+ \ JavaScript code in an elm.js file."

189 ]

193 ]

190

194

191 makeFlags =

195 makeFlags =

192 flags Make.Flags

196 flags Make.Flags

193 |-- onOff "debug" "Turn on the time-travelling debugger. It allows you to rewind and replay events. The events can be imported/exported into a file, which makes for very precise bug reports!"

197 |-- onOff "debug" "Turn on the time-travelling debugger. It allows you to rewind and replay events. The events can be imported/exported into a file, which makes for very precise bug reports!"

194 |-- onOff "optimize" "Turn on optimizations to make code smaller and faster. For example, the compiler renames record fields to be as short as possible and unboxes values to reduce allocation."

198 |-- onOff "optimize" "Turn on optimizations to make code smaller and faster. For example, the compiler renames record fields to be as short as possible and unboxes values to reduce allocation."

195− |-- flag "output" Make.output "Specify the name of the resulting JS file. For example --output=assets/elm.js to generate the JS at assets/elm.js or --output=/dev/null to generate no output at all!"

199+ |-- flag "output" Output.output "Specify the name of the resulting JS file. For example --output=assets/elm.js to generate the JS at assets/elm.js or --output=/dev/null to generate no output at all!"

196 |-- flag "report" Make.reportType "You can say --report=json to get error messages as JSON. This is only really useful if you are an editor plugin. Humans should avoid it!"

200 |-- flag "report" Make.reportType "You can say --report=json to get error messages as JSON. This is only really useful if you are an editor plugin. Humans should avoid it!"

197 |-- flag "docs" Make.docsFile "Generate a JSON file of documentation for a package. Eventually it will be possible to preview docs with `reactor` because it is quite hard to deal with these JSON files directly."

201 |-- flag "docs" Make.docsFile "Generate a JSON file of documentation for a package. Eventually it will be possible to preview docs with `reactor` because it is quite hard to deal with these JSON files directly."

198 in

202 in

199− Terminal.Command "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run

203+ Interface "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run

200

204

201

205

202

206

203-- INSTALL

207-- INSTALL

204

208

205

209

206−install :: Terminal.Command

210+install :: Interface

207install =

211install =

208 let

212 let

209 details =

213 details =

@@ -232,14 +236,14 @@ install =

232 , require1 Install.Install package

236 , require1 Install.Install package

233 ]

237 ]

234 in

238 in

235− Terminal.Command "install" Uncommon details example installArgs noFlags Install.run

239+ Interface "install" Uncommon details example installArgs noFlags Install.run

236

240

237

241

238

242

239-- PUBLISH

243-- PUBLISH

240

244

241

245

242−publish :: Terminal.Command

246+publish :: Interface

243publish =

247publish =

244 let

248 let

245 details =

249 details =

@@ -266,17 +270,17 @@ publish =

266 \ it ends up as an experiment on GitHub only. Point is, try to be\

270 \ it ends up as an experiment on GitHub only. Point is, try to be\

267 \ respectful of the community and package ecosystem!"

271 \ respectful of the community and package ecosystem!"

268 , reflow

272 , reflow

269− "Check out <https://package.elm-lang.org/help/design-guidelines> for guidance on how to create great packages!"

273+ "Check out <TODO> for guidance on how to create great packages!"

270 ]

274 ]

271 in

275 in

272− Terminal.Command "publish" Uncommon details example noArgs noFlags Publish.run

276+ Interface "publish" Uncommon details example noArgs noFlags Publish.run

273

277

274

278

275

279

276-- BUMP

280-- BUMP

277

281

278

282

279−bump :: Terminal.Command

283+bump :: Interface

280bump =

284bump =

281 let

285 let

282 details =

286 details =

@@ -289,14 +293,14 @@ bump =

289 \ it is a MAJOR change, and bump your version number to 2.0.0. I do this with\

293 \ it is a MAJOR change, and bump your version number to 2.0.0. I do this with\

290 \ all packages, so there cannot be MAJOR changes hiding in PATCH releases in Elm!"

294 \ all packages, so there cannot be MAJOR changes hiding in PATCH releases in Elm!"

291 in

295 in

292− Terminal.Command "bump" Uncommon details example noArgs noFlags Bump.run

296+ Interface "bump" Uncommon details example noArgs noFlags Bump.run

293

297

294

298

295

299

296-- DIFF

300-- DIFF

297

301

298

302

299−diff :: Terminal.Command

303+diff :: Interface

300diff =

304diff =

301 let

305 let

302 details =

306 details =

@@ -321,7 +325,7 @@ diff =

321 , require3 Diff.GlobalInquiry package version version

325 , require3 Diff.GlobalInquiry package version version

322 ]

326 ]

323 in

327 in

324− Terminal.Command "diff" Uncommon details example diffArgs noFlags Diff.run

328+ Interface "diff" Uncommon details example diffArgs noFlags Diff.run

325

329

326

330

327

331

terminal/src/Make.hs+268−113

@@ -1,4 +1,4 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}

2module Make

3 ( Flags(..)

4 , Output(..)

@@ -6,30 +6,36 @@ module Make

6 , run

7 , reportType

8 , output

9− , docsFile

10 )

9 )

11 where

10 where

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

14+import Control.Monad (liftM2)

14import qualified Data.ByteString.Builder as B

15import qualified Data.ByteString.Builder as B

16+import qualified Data.Map as Map

15import qualified Data.Maybe as Maybe

17import qualified Data.Maybe as Maybe

16import qualified Data.NonEmptyList as NE

18import qualified Data.NonEmptyList as NE

17−import qualified System.Directory as Dir

18import qualified System.FilePath as FP

19import qualified System.FilePath as FP

20import qualified AST.Optimized as Opt

21import qualified AST.Optimized as Opt

21−import qualified BackgroundWriter as BW

22import qualified Build

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

23import qualified Elm.Details as Details

24import qualified Elm.Details as Details

25+import qualified Elm.Interface as I

24import qualified Elm.ModuleName as ModuleName

26import qualified Elm.ModuleName as ModuleName

27+import qualified Elm.Outline as Outline

28+import qualified Elm.Package as Pkg

25import qualified File

29import qualified File

26−import qualified Generate

27import qualified Generate.Html as Html

30import qualified Generate.Html as Html

31+import qualified Generate.JavaScript as Generate

32+import qualified Generate.Mode as Mode

33+import qualified Nitpick.Debug as Nitpick

28import qualified Reporting

34import qualified Reporting

29import qualified Reporting.Exit as Exit

35import qualified Reporting.Exit as Exit

30import qualified Reporting.Task as Task

36import qualified Reporting.Task as Task

31import qualified Stuff

37import qualified Stuff

32−import Terminal (Parser(..))

38+import Terminal.Args (Parser(..))

@@ -42,7 +48,6 @@ data Flags =

42 , _optimize :: Bool

48 , _optimize :: Bool

43 , _output :: Maybe Output

49 , _output :: Maybe Output

44 , _report :: Maybe ReportType

50 , _report :: Maybe ReportType

45− , _docs :: Maybe FilePath

46 }

51 }

@@ -64,58 +69,54 @@ type Task a = Task.Task Exit.Make a

66run :: [FilePath] -> Flags -> IO ()

71run :: [FilePath] -> Flags -> IO ()

67−run paths flags@(Flags _ _ _ report _) =

72+run paths (Flags debug optimize maybeOutput report) =

68 do style <- getStyle report

73 do style <- getStyle report

69− maybeRoot <- Stuff.findRoot

74+ Reporting.attemptWithStyle style Exit.makeToReport $ Task.run $

70− Reporting.attemptWithStyle style Exit.makeToReport $

75+ do root <- getRoot

71− case maybeRoot of

76+ desiredMode <- getMode debug optimize

72− Just root -> runHelp root paths style flags

77+ details <- getDetails style root

73− Nothing -> return $ Left $ Exit.MakeNoOutline

78+ case paths of

74−

79+ [] ->

75−

80+ do exposed <- getExposed details

76−runHelp :: FilePath -> [FilePath] -> Reporting.Style -> Flags -> IO (Either Exit.Make ())

81+ _ <- buildExposed style root details exposed

77−runHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) =

82+ return ()

78− BW.withScope $ \scope ->

83+

79− Stuff.withRootLock root $ Task.run $

84+ p:ps ->

80− do desiredMode <- getMode debug optimize

85+ do artifacts <- buildPaths style root details (NE.List p ps)

81− details <- Task.eio Exit.MakeBadDetails (Details.load style scope root)

86+ case maybeOutput of

82− case paths of

87+ Nothing ->

83− [] ->

88+ case getMains artifacts of

84− do exposed <- getExposed details

89+ [] ->

85− buildExposed style root details maybeDocs exposed

90+ return ()

86−

91+

87− p:ps ->

92+ [name] ->

88− do artifacts <- buildPaths style root details (NE.List p ps)

93+ do builder <- toBuilder root details desiredMode artifacts

89− case maybeOutput of

94+ generate style "index.html" (Html.sandwich name builder) (NE.List name [])

90− Nothing ->

95+

91− case getMains artifacts of

96+ name:names ->

92− [] ->

97+ do builder <- toBuilder root details desiredMode artifacts

93− return ()

98+ generate style "elm.js" builder (NE.List name names)

94−

99+

95− [name] ->

100+ Just DevNull ->

96− do builder <- toBuilder root details desiredMode artifacts

101+ return ()

97− generate style "index.html" (Html.sandwich name builder) (NE.List name [])

102+

98−

103+ Just (JS target) ->

99− name:names ->

104+ case getNoMains artifacts of

100− do builder <- toBuilder root details desiredMode artifacts

105+ [] ->

101− generate style "elm.js" builder (NE.List name names)

106+ do builder <- toBuilder root details desiredMode artifacts

102−

107+ generate style target builder (getMainNames artifacts)

103− Just DevNull ->

108+

104− return ()

109+ name:names ->

105−

110+ Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names)

106− Just (JS target) ->

111+

107− case getNoMains artifacts of

112+ Just (Html target) ->

108− [] ->

113+ case hasOneMain artifacts of

109− do builder <- toBuilder root details desiredMode artifacts

114+ Just name ->

110− generate style target builder (Build.getRootNames artifacts)

115+ do builder <- toBuilder root details desiredMode artifacts

111−

116+ generate style target (Html.sandwich name builder) (NE.List name [])

112− name:names ->

117+

113− Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names)

118+ Nothing ->

114−

119+ Task.throw Exit.MakeMultipleFilesIntoHtml

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 [])

119

120

121

122

@@ -129,6 +130,14 @@ getStyle report =

129 Just Json -> return Reporting.json

130 Just Json -> return Reporting.json

130

131

132

133+getRoot :: Task FilePath

134+getRoot =

135+ do maybeRoot <- Task.io Stuff.findRoot

136+ case maybeRoot of

137+ Nothing -> Task.throw Exit.MakeNeedsOutline

138+ Just root -> return root

139+

140+

132getMode :: Bool -> Bool -> Task DesiredMode

141getMode :: Bool -> Bool -> Task DesiredMode

133getMode debug optimize =

142getMode debug optimize =

134 case (debug, optimize) of

143 case (debug, optimize) of

@@ -138,14 +147,19 @@ getMode debug optimize =

138 (False, True ) -> return Prod

147 (False, True ) -> return Prod

139

148

140

149

150+getDetails :: Reporting.Style -> FilePath -> Task Details.Details

151+getDetails style root =

152+ Task.eio Exit.MakeBlockedByDetailsProblem (Details.load style root)

153+

154+

141getExposed :: Details.Details -> Task (NE.List ModuleName.Raw)

155getExposed :: Details.Details -> Task (NE.List ModuleName.Raw)

142−getExposed (Details.Details _ validOutline _ _ _ _) =

156+getExposed (Details.Details _ validOutline _ _ _) =

143 case validOutline of

157 case validOutline of

144 Details.ValidApp _ ->

158 Details.ValidApp _ ->

145 Task.throw Exit.MakeAppNeedsFileNames

159 Task.throw Exit.MakeAppNeedsFileNames

146

160

147− Details.ValidPkg _ exposed _ ->

161+ Details.ValidPkg (Outline.PkgOutline _ _ _ _ exposed _ _ _) _ ->

148− case exposed of

162+ case Outline.flattenExposed exposed of

149 [] -> Task.throw Exit.MakePkgNeedsExposing

163 [] -> Task.throw Exit.MakePkgNeedsExposing

150 m:ms -> return (NE.List m ms)

164 m:ms -> return (NE.List m ms)

151

165

@@ -154,19 +168,16 @@ getExposed (Details.Details _ validOutline _ _ _ _) =

154-- BUILD PROJECTS

168-- BUILD PROJECTS

155

169

156

170

157−buildExposed :: Reporting.Style -> FilePath -> Details.Details -> Maybe FilePath -> NE.List ModuleName.Raw -> Task ()

171+buildExposed :: Reporting.Style -> FilePath -> Details.Details -> NE.List ModuleName.Raw -> Task ()

158−buildExposed style root details maybeDocs exposed =

172+buildExposed style root details exposed =

159− let

160− docsGoal = maybe Build.IgnoreDocs Build.WriteDocs maybeDocs

161− in

162 Task.eio Exit.MakeCannotBuild $

173 Task.eio Exit.MakeCannotBuild $

163− Build.fromExposed style root details docsGoal exposed

174+ Build.fromExposed style root details exposed

164

175

165

176

166buildPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> Task Build.Artifacts

177buildPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> Task Build.Artifacts

167buildPaths style root details paths =

178buildPaths style root details paths =

168 Task.eio Exit.MakeCannotBuild $

179 Task.eio Exit.MakeCannotBuild $

169− Build.fromPaths style root details paths

180+ Build.fromMains style root details paths

170

181

171

182

172

183

@@ -174,13 +185,13 @@ buildPaths style root details paths =

174

185

175

186

176getMains :: Build.Artifacts -> [ModuleName.Raw]

187getMains :: Build.Artifacts -> [ModuleName.Raw]

177−getMains (Build.Artifacts _ _ roots modules) =

188+getMains (Build.Artifacts _ _ mains modules) =

178− Maybe.mapMaybe (getMain modules) (NE.toList roots)

189+ Maybe.mapMaybe (getMain modules) (NE.toList mains)

179

190

180

191

181−getMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw

192+getMain :: [Build.Module] -> Build.Main -> Maybe ModuleName.Raw

182−getMain modules root =

193+getMain modules main =

183− case root of

194+ case main of

184 Build.Inside name ->

195 Build.Inside name ->

185 if any (isMain name) modules

196 if any (isMain name) modules

186 then Just name

197 then Just name

@@ -206,11 +217,11 @@ isMain targetName modul =

206-- HAS ONE MAIN

217-- HAS ONE MAIN

207

218

208

219

209−hasOneMain :: Build.Artifacts -> Task ModuleName.Raw

220+hasOneMain :: Build.Artifacts -> Maybe ModuleName.Raw

210−hasOneMain (Build.Artifacts _ _ roots modules) =

221+hasOneMain (Build.Artifacts _ _ mains modules) =

211− case roots of

222+ case mains of

212− NE.List root [] -> Task.mio Exit.MakeNoMain (return $ getMain modules root)

223+ NE.List main [] -> getMain modules main

213− NE.List _ (_:_) -> Task.throw Exit.MakeMultipleFilesIntoHtml

224+ NE.List _ (_:_) -> Nothing

214

225

215

226

216

227

@@ -218,13 +229,13 @@ hasOneMain (Build.Artifacts _ _ roots modules) =

218

229

219

230

220getNoMains :: Build.Artifacts -> [ModuleName.Raw]

231getNoMains :: Build.Artifacts -> [ModuleName.Raw]

221−getNoMains (Build.Artifacts _ _ roots modules) =

232+getNoMains (Build.Artifacts _ _ mains modules) =

222− Maybe.mapMaybe (getNoMain modules) (NE.toList roots)

233+ Maybe.mapMaybe (getNoMain modules) (NE.toList mains)

223

234

224

235

225−getNoMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw

236+getNoMain :: [Build.Module] -> Build.Main -> Maybe ModuleName.Raw

226−getNoMain modules root =

237+getNoMain modules main =

227− case root of

238+ case main of

228 Build.Inside name ->

239 Build.Inside name ->

229 if any (isMain name) modules

240 if any (isMain name) modules

230 then Nothing

241 then Nothing

@@ -237,14 +248,29 @@ getNoMain modules root =

237

248

238

249

239

250

251+-- GET MAIN NAMES

252+

253+

254+getMainNames :: Build.Artifacts -> NE.List ModuleName.Raw

255+getMainNames (Build.Artifacts _ _ mains _) =

256+ fmap getMainName mains

257+

258+

259+getMainName :: Build.Main -> ModuleName.Raw

260+getMainName main =

261+ case main of

262+ Build.Inside name -> name

263+ Build.Outside name _ _ -> name

264+

265+

266+

240-- GENERATE

267-- GENERATE

241

268

242

269

243generate :: Reporting.Style -> FilePath -> B.Builder -> NE.List ModuleName.Raw -> Task ()

270generate :: Reporting.Style -> FilePath -> B.Builder -> NE.List ModuleName.Raw -> Task ()

244generate style target builder names =

271generate style target builder names =

245 Task.io $

272 Task.io $

246− do Dir.createDirectoryIfMissing True (FP.takeDirectory target)

273+ do File.writeBuilder target builder

247− File.writeBuilder target builder

248 Reporting.reportGenerate style names target

274 Reporting.reportGenerate style names target

249

275

250

276

@@ -256,12 +282,150 @@ data DesiredMode = Debug | Dev | Prod

256

282

257

283

258toBuilder :: FilePath -> Details.Details -> DesiredMode -> Build.Artifacts -> Task B.Builder

284toBuilder :: FilePath -> Details.Details -> DesiredMode -> Build.Artifacts -> Task B.Builder

259−toBuilder root details desiredMode artifacts =

285+toBuilder root details desiredMode (Build.Artifacts pkg ifaces roots modules) =

260− Task.mapError Exit.MakeBadGenerate $

286+ case desiredMode of

261− case desiredMode of

287+ Debug ->

262− Debug -> Generate.debug root details artifacts

288+ do loading <- loadObjects root details modules

263− Dev -> Generate.dev root details artifacts

289+ types <- loadTypes root ifaces modules

264− Prod -> Generate.prod root details artifacts

290+ objects <- finalizeObjects loading

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

292+ let graph = toGlobalGraph objects

293+ let mains = gatherMains pkg objects roots

294+ return $ Generate.generate mode graph mains

295+

296+ Dev ->

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

298+ let mode = Mode.Dev Nothing

299+ let graph = toGlobalGraph objects

300+ let mains = gatherMains pkg objects roots

301+ return $ Generate.generate mode graph mains

302+

303+ Prod ->

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

305+ checkForDebugUses objects

306+ let graph = toGlobalGraph objects

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

308+ let mains = gatherMains pkg objects roots

309+ return $ Generate.generate mode graph mains

310+

311+

312+checkForDebugUses :: LoadedObjects -> Task ()

313+checkForDebugUses (LoadedObjects _ locals) =

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

315+ [] -> return ()

316+ m:ms -> Task.throw (Exit.MakeCannotOptimizeDebugValues m ms)

317+

318+

319+toGlobalGraph :: LoadedObjects -> Opt.GlobalGraph

320+toGlobalGraph (LoadedObjects globals locals) =

321+ foldr Opt.addLocalGraph globals locals

322+

323+

324+

325+-- LOAD OBJECTS

326+

327+

328+data LoadingObjects =

329+ LoadingObjects

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

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

332+ }

333+

334+

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

336+loadObjects root details modules =

337+ Task.io $

338+ do mvar <- Details.loadObjects root details

339+ mvars <- traverse (loadObject root) modules

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

341+

342+

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

344+loadObject root modul =

345+ case modul of

346+ Build.Fresh name _ graph ->

347+ do mvar <- newMVar (Just graph)

348+ return (name, mvar)

349+

350+ Build.Cached name _ _ ->

351+ do mvar <- newEmptyMVar

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

353+ return (name, mvar)

354+

355+

356+data LoadedObjects =

357+ LoadedObjects

358+ { _foreign :: Opt.GlobalGraph

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

360+ }

361+

362+

363+finalizeObjects :: LoadingObjects -> Task LoadedObjects

364+finalizeObjects (LoadingObjects mvar mvars) =

365+ Task.eio id $

366+ do result <- readMVar mvar

367+ results <- traverse readMVar mvars

368+ case liftM2 LoadedObjects result (sequence results) of

369+ Just loaded -> return (Right loaded)

370+ Nothing -> return (Left Exit.MakeCannotLoadArtifacts)

371+

372+

373+

374+-- LOAD TYPES

375+

376+

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

378+loadTypes root ifaces modules =

379+ Task.eio id $

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

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

382+ results <- traverse readMVar mvars

383+ case sequence results of

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

385+ Nothing -> return (Left Exit.MakeCannotLoadArtifacts)

386+

387+

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

389+loadTypesHelp root modul =

390+ case modul of

391+ Build.Fresh name iface _ ->

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

393+

394+ Build.Cached name _ ciMVar ->

395+ do cachedInterface <- readMVar ciMVar

396+ case cachedInterface of

397+ Build.Unneeded ->

398+ do mvar <- newEmptyMVar

399+ _ <- forkIO $

400+ do maybeIface <- File.readBinary (Stuff.elmo root name)

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

402+ return mvar

403+

404+ Build.Loaded iface ->

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

406+

407+ Build.Corrupted ->

408+ newMVar Nothing

409+

410+

411+

412+-- GATHER MAINS

413+

414+

415+gatherMains :: Pkg.Name -> LoadedObjects -> NE.List Build.Main -> Map.Map ModuleName.Canonical Opt.Main

416+gatherMains pkg (LoadedObjects _ locals) buildMains =

417+ Map.fromList $ Maybe.mapMaybe (lookupMain pkg locals) (NE.toList buildMains)

418+

419+

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

421+lookupMain pkg locals buildMain =

422+ let

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

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

425+ in

426+ case buildMain of

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

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

265

429

266

430

267

431

@@ -286,34 +450,25 @@ output =

286 , _plural = "output files"

450 , _plural = "output files"

287 , _parser = parseOutput

451 , _parser = parseOutput

288 , _suggest = \_ -> return []

452 , _suggest = \_ -> return []

289− , _examples = \_ -> return [ "elm.js", "index.html", "/dev/null" ]

453+ , _examples = exampleOutput

290 }

454 }

291

455

292

456

293parseOutput :: String -> Maybe Output

457parseOutput :: String -> Maybe Output

294−parseOutput name

458+parseOutput string =

295− | isDevNull name = Just DevNull

459+ if string == "/dev/null" || string == "NUL" || string == "$null" then

296− | hasExt ".html" name = Just (Html name)

460+ Just DevNull

297− | hasExt ".js" name = Just (JS name)

298− | otherwise = Nothing

299−

300

461

301−docsFile :: Parser FilePath

462+ else if FP.takeExtension string == ".html" && length string > 5 then

302−docsFile =

463+ Just (Html string)

303− Parser

304− { _singular = "json file"

305− , _plural = "json files"

306− , _parser = \name -> if hasExt ".json" name then Just name else Nothing

307− , _suggest = \_ -> return []

308− , _examples = \_ -> return ["docs.json","documentation.json"]

309− }

310

464

465+ else if FP.takeExtension string == ".js" && length string > 3 then

466+ Just (JS string)

311

467

312−hasExt :: String -> String -> Bool

468+ else

313−hasExt ext path =

469+ Nothing

314− FP.takeExtension path == ext && length path > length ext

315

470

316

471

317−isDevNull :: String -> Bool

472+exampleOutput :: String -> IO [String]

318−isDevNull name =

473+exampleOutput _ =

319− name == "/dev/null" || name == "NUL" || name == "$null"

474+ return [ "elm.js", "index.html", "/dev/null" ]

terminal/src/Publish.hs+8−529

@@ -1,540 +1,19 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+module Publish (run) where

2−module Publish

3− ( run

4− )

5− where

8−import Control.Exception (bracket_)

4+import qualified Elm.Project as Project

9−import Control.Monad (void)

5+import qualified Elm.Publish as Publish

10−import qualified Data.List as List

11−import qualified Data.NonEmptyList as NE

12−import qualified Data.Utf8 as Utf8

13−import qualified System.Directory as Dir

14−import qualified System.Exit as Exit

15−import System.FilePath ((</>))

16−import qualified System.Info as Info

17−import qualified System.IO as IO

18−import qualified System.Process as Process

19−

20−import qualified BackgroundWriter as BW

21−import qualified Build

22−import qualified Deps.Bump as Bump

23−import qualified Deps.Diff as Diff

24−import qualified Deps.Registry as Registry

25−import qualified Deps.Website as Website

26−import qualified Elm.Details as Details

27−import qualified Elm.Docs as Docs

28−import qualified Elm.Magnitude as M

29−import qualified Elm.Outline as Outline

30−import qualified Elm.Package as Pkg

31−import qualified Elm.Version as V

32−import qualified File

33−import qualified Http

34−import qualified Json.Decode as D

35−import qualified Json.String as Json

36−import qualified Reporting

37−import Reporting.Doc ((<+>))

38−import qualified Reporting.Doc as D

39−import qualified Reporting.Exit as Exit

40−import qualified Reporting.Exit.Help as Help

41import qualified Reporting.Task as Task

6import qualified Reporting.Task as Task

42−import qualified Stuff

7+import qualified Reporting.Progress.Terminal as Terminal

46-- RUN

11-- RUN

49−-- TODO mandate no "exposing (..)" in packages to make

50−-- optimization to skip builds in Elm.Details always valid

51−

52−

53run :: () -> () -> IO ()

14run :: () -> () -> IO ()

54run () () =

15run () () =

55− Reporting.attempt Exit.publishToReport $

16+ do reporter <- Terminal.create

56− Task.run $ publish =<< getEnv

17+ Task.run reporter $

57−

18+ do summary <- Project.getRoot

58−

19+ Publish.publish summary

59−

60−-- ENV

61−

62−

63−data Env =

64− Env

65− { _root :: FilePath

66− , _cache :: Stuff.PackageCache

67− , _manager :: Http.Manager

68− , _registry :: Registry.Registry

69− , _outline :: Outline.Outline

70− }

71−

72−

73−getEnv :: Task.Task Exit.Publish Env

74−getEnv =

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

81−

82−

83−

84−-- PUBLISH

85−

86−

87−publish :: Env -> Task.Task Exit.Publish ()

88−publish env@(Env root _ manager registry outline) =

89− case outline of

90− Outline.App _ ->

91− Task.throw Exit.PublishApplication

92−

93− Outline.Pkg (Outline.PkgOutline pkg summary _ vsn exposed _ _ _) ->

94− do let maybeKnownVersions = Registry.getVersions pkg registry

95−

96− reportPublishStart pkg vsn maybeKnownVersions

97−

98− if noExposed exposed then Task.throw Exit.PublishNoExposed else return ()

99− if badSummary summary then Task.throw Exit.PublishNoSummary else return ()

100−

101− verifyReadme root

102− verifyLicense root

103− docs <- verifyBuild root

104− verifyVersion env pkg vsn docs maybeKnownVersions

105− git <- getGit

106− commitHash <- verifyTag git manager pkg vsn

107− verifyNoChanges git commitHash vsn

108− zipHash <- verifyZip env pkg vsn

109−

110− Task.io $ putStrLn ""

111− register manager pkg vsn docs commitHash zipHash

112− Task.io $ putStrLn "Success!"

113−

114−

115−

116−-- VERIFY SUMMARY

117−

118−

119−badSummary :: Json.String -> Bool

120−badSummary summary =

121− Json.isEmpty summary || Outline.defaultSummary == summary

122−

123−

124−noExposed :: Outline.Exposed -> Bool

125−noExposed exposed =

126− case exposed of

127− Outline.ExposedList modules ->

128− null modules

129−

130− Outline.ExposedDict chunks ->

131− all (null . snd) chunks

132−

133−

134−

135−-- VERIFY README

136−

137−

138−verifyReadme :: FilePath -> Task.Task Exit.Publish ()

139−verifyReadme root =

140− reportReadmeCheck $

141− do let readmePath = root </> "README.md"

142− exists <- File.exists readmePath

143− case exists of

144− False ->

145− return (Left Exit.PublishNoReadme)

146−

147− True ->

148− do size <- IO.withFile readmePath IO.ReadMode IO.hFileSize

149− if size < 300

150− then return (Left Exit.PublishShortReadme)

151− else return (Right ())

152−

153−

154−

155−-- VERIFY LICENSE

156−

157−

158−verifyLicense :: FilePath -> Task.Task Exit.Publish ()

159−verifyLicense root =

160− reportLicenseCheck $

161− do let licensePath = root </> "LICENSE"

162− exists <- File.exists licensePath

163− if exists

164− then return (Right ())

165− else return (Left Exit.PublishNoLicense)

166−

167−

168−

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−

219−-- VERIFY GITHUB TAG

220−

221−

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)

230−

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)

240−

241−

242−toTagUrl :: Pkg.Name -> V.Version -> String

243−toTagUrl pkg vsn =

244− "https://api.github.com/repos/" ++ Pkg.toUrl pkg ++ "/git/refs/tags/" ++ V.toChars vsn

245−

246−

247−commitHashDecoder :: D.Decoder e String

248−commitHashDecoder =

249− Utf8.toChars <$>

250− D.field "object" (D.field "sha" D.string)

251−

252−

253−

254−-- VERIFY NO LOCAL CHANGES SINCE TAG

255−

256−

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)

265−

266−

267−

268−-- VERIFY THAT ZIP BUILDS / COMPUTE HASH

269−

270−

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

279− Exit.PublishCannotGetZip

280− (Exit.PublishCannotDecodeZip url)

281− (return . Right)

282−

283− Task.io $ File.writePackage prepublishDir archive

284−

285− reportZipBuildCheck $

286− Dir.withCurrentDirectory prepublishDir $

287− verifyZipBuild prepublishDir

288−

289− return sha

290−

291−

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 =

299− let

300− dir = Stuff.prepublishDir root

301− in

302− Task.eio id $

303− bracket_

304− (Dir.createDirectoryIfMissing True dir)

305− (Dir.removeDirectoryRecursive dir)

306− (Task.run (callback dir))

307−

308−

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 ()

326−

327−

328−

329−-- VERIFY VERSION

330−

331−

332−data GoodVersion

333− = GoodStart

334− | GoodBump V.Version M.Magnitude

335−

336−

337−verifyVersion :: Env -> Pkg.Name -> V.Version -> Docs.Documentation -> Maybe Registry.KnownVersions -> Task.Task Exit.Publish ()

338−verifyVersion env pkg vsn newDocs publishedVersions =

339− reportSemverCheck vsn $

340− case publishedVersions of

341− Nothing ->

342− if vsn == V.one

343− then return $ Right GoodStart

344− else return $ Left $ Exit.PublishNotInitialVersion vsn

345−

346− Just knownVersions@(Registry.KnownVersions latest previous) ->

347− if vsn == latest || elem vsn previous

348− then return $ Left $ Exit.PublishAlreadyPublished vsn

349− else verifyBump env pkg vsn newDocs knownVersions

350−

351−

352−verifyBump :: Env -> Pkg.Name -> V.Version -> Docs.Documentation -> Registry.KnownVersions -> IO (Either Exit.Publish GoodVersion)

353−verifyBump (Env _ cache manager _ _) pkg vsn newDocs knownVersions@(Registry.KnownVersions latest _) =

354− case List.find (\(_ ,new, _) -> vsn == new) (Bump.getPossibilities knownVersions) of

355− Nothing ->

356− return $ Left $

357− Exit.PublishInvalidBump vsn latest

358−

359− Just (old, new, magnitude) ->

360− do result <- Diff.getDocs cache manager pkg old

361− case result of

362− Left dp ->

363− return $ Left $ Exit.PublishCannotGetDocs old new dp

364−

365− Right oldDocs ->

366− let

367− changes = Diff.diff oldDocs newDocs

368− realNew = Diff.bump changes old

369− in

370− if new == realNew

371− then return $ Right $ GoodBump old magnitude

372− else

373− return $ Left $

374− Exit.PublishBadBump old new magnitude realNew (Diff.toMagnitude changes)

375−

376−

377−

378−-- REGISTER PACKAGES

379−

380−

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 =

383− let

384− url =

385− Website.route "/register"

386− [ ("name", Pkg.toChars pkg)

387− , ("version", V.toChars vsn)

388− , ("commit-hash", commitHash)

389− ]

390− in

391− Task.eio Exit.PublishCannotRegister $

392− Http.upload manager url

393− [ Http.filePart "elm.json" "elm.json"

394− , Http.jsonPart "docs.json" "docs.json" (Docs.encode docs)

395− , Http.filePart "README.md" "README.md"

396− , Http.stringPart "github-hash" (Http.shaToChars sha)

397− ]

398−

399−

400−

401−-- REPORTING

402−

403−

404−reportPublishStart :: Pkg.Name -> V.Version -> Maybe Registry.KnownVersions -> Task.Task x ()

405−reportPublishStart pkg vsn maybeKnownVersions =

406− Task.io $

407− case maybeKnownVersions of

408− Nothing ->

409− putStrLn $ Exit.newPackageOverview ++ "\nI will now verify that everything is in order...\n"

410−

411− Just _ ->

412− putStrLn $ "Verifying " ++ Pkg.toChars pkg ++ " " ++ V.toChars vsn ++ " ...\n"

413−

414−

415−

416−-- REPORTING PHASES

417−

418−

419−reportReadmeCheck :: IO (Either x a) -> Task.Task x a

420−reportReadmeCheck =

421− reportCheck

422− "Looking for README.md"

423− "Found README.md"

424− "Problem with your README.md"

425−

426−

427−reportLicenseCheck :: IO (Either x a) -> Task.Task x a

428−reportLicenseCheck =

429− reportCheck

430− "Looking for LICENSE"

431− "Found LICENSE"

432− "Problem with your LICENSE"

433−

434−

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 =

445− let

446− vsn = V.toChars version

447−

448− waiting = "Checking semantic versioning rules. Is " ++ vsn ++ " correct?"

449− failure = "Version " ++ vsn ++ " is not correct!"

450− success result =

451− case result of

452− GoodStart ->

453− "All packages start at version " ++ V.toChars V.one

454−

455− GoodBump oldVersion magnitude ->

456− "Version number " ++ vsn ++ " verified ("

457− ++ M.toChars magnitude ++ " change, "

458− ++ V.toChars oldVersion ++ " => " ++ vsn ++ ")"

459− in

460− void $ reportCustomCheck waiting success failure work

461−

462−

463−reportTagCheck :: V.Version -> IO (Either x a) -> Task.Task x a

464−reportTagCheck vsn =

465− reportCheck

466− ("Is version " ++ V.toChars vsn ++ " tagged on GitHub?")

467− ("Version " ++ V.toChars vsn ++ " is tagged on GitHub")

468− ("Version " ++ V.toChars vsn ++ " is not tagged on GitHub!")

469−

470−

471−reportDownloadCheck :: IO (Either x a) -> Task.Task x a

472−reportDownloadCheck =

473− reportCheck

474− "Downloading code from GitHub..."

475− "Code downloaded successfully from GitHub"

476− "Could not download code from GitHub!"

477−

478−

479−reportLocalChangesCheck :: IO (Either x a) -> Task.Task x a

480−reportLocalChangesCheck =

481− reportCheck

482− "Checking for uncommitted changes..."

483− "No uncommitted changes in local code"

484− "Your local code is different than the code tagged on GitHub"

485−

486−

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

498−

499−

500−reportCustomCheck :: String -> (a -> String) -> String -> IO (Either x a) -> Task.Task x a

501−reportCustomCheck waiting success failure work =

502− let

503− putFlush doc =

504− Help.toStdout doc >> IO.hFlush IO.stdout

505−

506− padded message =

507− message ++ replicate (length waiting - length message) ' '

508− in

509− Task.eio id $

510− do putFlush $ " " <> waitingMark <+> D.fromChars waiting

511− result <- work

512− putFlush $

513− case result of

514− Right a -> "\r " <> goodMark <+> D.fromChars (padded (success a) ++ "\n")

515− Left _ -> "\r " <> badMark <+> D.fromChars (padded failure ++ "\n\n")

516−

517− return result

518−

519−

520−-- MARKS

521−

522−

523−goodMark :: D.Doc

524−goodMark =

525− D.green $ if isWindows then "+" else "●"

526−

527−

528−badMark :: D.Doc

529−badMark =

530− D.red $ if isWindows then "X" else "✗"

531−

532−

533−waitingMark :: D.Doc

534−waitingMark =

535− D.dullyellow $ if isWindows then "-" else "→"

536−

537−

538−isWindows :: Bool

539−isWindows =

540− Info.os == "mingw32"

terminal/src/Repl.hs+197−522

This diff is too big to show here.

terminal/impl/Terminal.hs → terminal/src/Terminal/Args.hsrenamed+27−33

This diff is too big to show here.

terminal/impl/Terminal/Chomp.hs → terminal/src/Terminal/Args/Chomp.hsrenamed+5−4

This diff is too big to show here.

terminal/impl/Terminal/Error.hs → terminal/src/Terminal/Args/Error.hsrenamed+18−28

This diff is too big to show here.

terminal/impl/Terminal/Helpers.hs → terminal/src/Terminal/Args/Helpers.hsrenamed+19−41

This diff is too big to show here.

terminal/impl/Terminal/Internal.hs → terminal/src/Terminal/Args/Internal.hsrenamed+8−8

This diff is too big to show here.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

worker/elm.cabal+3−25

This diff is too big to show here.

worker/elm.jsondeleted−26

This diff is too big to show here.

worker/nginx.confdeleted−22

This diff is too big to show here.

worker/outlines/compile/elm.jsondeleted−32

This diff is too big to show here.

worker/outlines/repl/elm.jsondeleted−19

This diff is too big to show here.

worker/src/Artifacts.hsdeleted−155

This diff is too big to show here.

worker/src/Cors.hsdeleted−48

This diff is too big to show here.

worker/src/Endpoint/Compile.hsdeleted−323

This diff is too big to show here.

worker/src/Endpoint/Quotes.hsdeleted−114

This diff is too big to show here.

worker/src/Endpoint/Repl.hsdeleted−244

This diff is too big to show here.

worker/src/Errors.elmdeleted−217

This diff is too big to show here.

worker/src/Main.hs+241−36

This diff is too big to show here.