fe1d53a · elk · git.iko.soy

git.iko.soy/elk

Refactor representation of "exposing" and documentation

There used to be AST.Variable.Listing, but now everything related to that lives in AST.Exposing. It also represents the Raw and Canonical phases, so everything has regions at first, and later it gets nicely sorted into values, aliases, and unions. I also cleaned up Docs.AST because I needed to mess with that code based on the changes in AST.Exposing Fix #1288, detect when there are duplicates in the module comment. Also add -Wall and make exports explicit in some cases.

commitfe1d53a657e7cd9a83650e11a463da365123e364 authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 24 Mar 2017, 01:42 (10 years ago) parent79dee76

17 files changed+670−614

compare with master

unifiedsplit

elm-compiler.cabal+2 src/AST/Exposing.hs+80 src/AST/Module.hs+9−8 src/AST/Variable.hs+67−170 src/Canonicalize.hs+127−142 src/Canonicalize/Effects.hs+9−4 src/Canonicalize/Setup.hs+79−97 src/Docs/AST.hs+64−19 src/Docs/Centralize.hs+5−6 src/Docs/Check.hs+112−98 src/Elm/Compiler/Imports.hs+30−17 src/Elm/Compiler/Type.hs+1−1 src/Elm/Docs.hs+7−11 src/Nitpick/Pattern.hs+2−2 src/Parse/Module.hs+25−24 src/Reporting/Annotation.hs+39−13 src/Reporting/Error/Docs.hs+12−2

elm-compiler.cabal+2

@@ -58,6 +58,7 @@ Library

5858 other-modules:

5959 AST.Declaration,

6060 AST.Effects,

61+ AST.Exposing,

6162 AST.Expression.Canonical,

6263 AST.Expression.Optimized,

6364 AST.Expression.Source,

@@ -154,6 +155,7 @@ Library

154155 parsec,

155156 pretty >= 1.0 && < 2.0,

156157 process,

158+ semigroups,

157159 text >= 1 && < 2,

158160 union-find >= 0.2 && < 0.3

159161

src/AST/Exposing.hsnew file+80

@@ -0,0 +1,80 @@

1+{-# OPTIONS_GHC -Wall #-}

2+module AST.Exposing

3+ ( Canonical(..)

4+ , nothing

5+ , Raw

6+ , Exposing(..)

7+ , closed

8+ , Entry(..)

9+ , getName

10+ )

11+ where

12+

13+import Data.Binary (Binary, get, put)

14+import Data.Text (Text)

15+

16+import qualified Reporting.Annotation as A

17+

18+

19+

20+-- CANONICAL

21+

22+

23+data Canonical =

24+ Canonical

25+ { _values :: ![Text]

26+ , _aliases :: ![Text]

27+ , _unions :: ![(Text, [Text])]

28+ }

29+

30+

31+nothing :: Canonical

32+nothing =

33+ Canonical [] [] []

34+

35+

36+

37+-- RAW

38+

39+

40+type Raw = Exposing Entry

41+

42+

43+data Exposing a

44+ = Open

45+ | Explicit ![A.Located a]

46+

47+

48+closed :: Exposing a

49+closed =

50+ Explicit []

51+

52+

53+data Entry

54+ = Lower !Text

55+ | Upper !Text (Maybe (Exposing Text))

56+

57+

58+getName :: Entry -> Text

59+getName entry =

60+ case entry of

61+ Lower name ->

62+ name

63+

64+ Upper name _ ->

65+ name

66+

67+

68+

69+-- BINARY

70+

71+

72+instance Binary Canonical where

73+ get =

74+ Canonical <$> get <*> get <*> get

75+

76+ put (Canonical values aliases unions) =

77+ do put values

78+ put aliases

79+ put unions

80+

src/AST/Module.hs+9−8

@@ -24,6 +24,7 @@ import Data.Text (Text)

2424

2525import qualified AST.Declaration as Decl

2626import qualified AST.Effects as Effects

27+import qualified AST.Exposing as Exposing

2728import qualified AST.Expression.Canonical as Canonical

2829import qualified AST.Expression.Optimized as Optimized

2930import qualified AST.Module.Name as Name

@@ -50,7 +51,7 @@ data HeaderDecl =

5051 HeaderDecl

5152 { _tag :: SourceTag

5253 , _name :: Name.Raw

53− , _exports :: Var.Listing (A.Located Var.Value)

54+ , _exports :: Exposing.Raw

5455 , _settings :: SourceSettings

5556 , _docs :: A.Located (Maybe Text)

5657 }

@@ -62,7 +63,7 @@ defaultHeaderDecl =

6263 zero = R.Position 1 1

6364 noDocs = A.at zero zero Nothing

6465 in

65− HeaderDecl Normal "Main" Var.openListing emptySettings noDocs

66+ HeaderDecl Normal "Main" Exposing.Open emptySettings noDocs

6667

6768

6869

@@ -85,7 +86,7 @@ data SourceInfo =

8586 { srcTag :: SourceTag

8687 , srcSettings :: SourceSettings

8788 , srcDocs :: A.Located (Maybe Text)

88− , srcExports :: Var.Listing (A.Located Var.Value)

89+ , srcExports :: Exposing.Raw

8990 , srcImports :: [UserImport]

9091 , srcDecls :: [Decl.Source]

9192 }

@@ -113,7 +114,7 @@ type Valid =

113114data ValidInfo =

114115 Valid

115116 { validDocs :: A.Located (Maybe Text)

116− , validExports :: Var.Listing (A.Located Var.Value)

117+ , validExports :: Exposing.Raw

117118 , validImports :: ([DefaultImport], [UserImport])

118119 , validDecls :: Decl.Valid

119120 , validEffects :: Effects.Raw

@@ -141,7 +142,7 @@ type DefaultImport = (Name.Raw, ImportMethod)

141142data ImportMethod =

142143 ImportMethod

143144 { alias :: Maybe Text

144− , exposedVars :: !(Var.Listing Var.Value)

145+ , exposedVars :: !Exposing.Raw

145146 }

146147

147148

@@ -152,7 +153,7 @@ data ImportMethod =

152153data Info program =

153154 Info

154155 { docs :: A.Located (Maybe Docs.Centralized)

155− , exports :: [Var.Value]

156+ , exports :: Exposing.Canonical

156157 , imports :: [Name.Raw]

157158 , program :: program

158159 , types :: Types

@@ -194,7 +195,7 @@ type Interfaces =

194195{-| Key facts about a module, used when reading info from .elmi files. -}

195196data Interface =

196197 Interface

197− { iExports :: [Var.Value]

198+ { iExports :: Exposing.Canonical

198199 , iImports :: [Name.Raw] -- TODO perhaps use this to crawl faster

199200 , iTypes :: Types

200201 , iUnions :: Unions

@@ -226,7 +227,7 @@ privatize (Interface _ _ _ myUnions myAliases _) =

226227

227228 else

228229 Just $ Interface

229− { iExports = []

230+ { iExports = Exposing.nothing

230231 , iImports = []

231232 , iTypes = Map.empty

232233 , iUnions = myUnions

src/AST/Variable.hs+67−170

@@ -1,12 +1,20 @@

11{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE FlexibleInstances #-}

23{-# LANGUAGE OverloadedStrings #-}

3−module AST.Variable where

4+module AST.Variable

5+ ( Raw(..), Canonical(..), Home(..)

6+ , local, topLevel, builtin, fromModule

7+ , inCore, inHtml, cmd, sub

8+ , isLocalHome, isCons

9+ , is, isJson, isMaybe, isArray, isTask, isList

10+ , isNative, isTuple, isPrimitive, isPrim, isLocal

11+ , rawToText, toText

12+ )

13+ where

414

515import Data.Binary

6−import qualified Data.Maybe as Maybe

716import Data.Monoid ((<>))

817import qualified Data.Set as Set

9−import qualified Data.Text as Text

1018import Data.Text (Text)

1119

1220import qualified AST.Helpers as Help

@@ -18,7 +26,7 @@ import qualified AST.Module.Name as ModuleName

1826

1927

2028newtype Raw = Raw Text

21− deriving (Eq, Ord)

29+ deriving (Eq, Ord)

2230

2331

2432

@@ -26,20 +34,25 @@ newtype Raw = Raw Text

2634

2735

2836data Home

29− = BuiltIn

30− | Module ModuleName.Canonical

31− | TopLevel ModuleName.Canonical

32− | Local

33− deriving (Eq, Ord)

37+ = BuiltIn

38+ | Module !ModuleName.Canonical

39+ | TopLevel !ModuleName.Canonical

40+ | Local

41+ deriving (Eq, Ord)

3442

3543

36−data Canonical = Canonical

44+data Canonical =

45+ Canonical

3746 { _home :: !Home

3847 , _name :: !Text

3948 }

4049 deriving (Eq, Ord)

4150

4251

52+

53+-- HELPERS

54+

55+

4356local :: Text -> Canonical

4457local x =

4558 Canonical Local x

@@ -60,16 +73,6 @@ fromModule home name =

6073 Canonical (Module home) name

6174

6275

63−localize :: Canonical -> Canonical

64−localize var@(Canonical home name) =

65− case home of

66− TopLevel _ ->

67− Canonical Local name

68−

69− _ ->

70− var

71−

72−

7376inCore :: ModuleName.Raw -> Text -> Canonical

7477inCore home name =

7578 Canonical (Module (ModuleName.inCore home)) name

@@ -110,6 +113,16 @@ isLocalHome home =

110113 True

111114

112115

116+isCons :: Canonical -> Bool

117+isCons var =

118+ case var of

119+ Canonical BuiltIn "::" ->

120+ True

121+

122+ _ ->

123+ False

124+

125+

113126is :: ModuleName.Raw -> Text -> Canonical -> Bool

114127is home name var =

115128 var == inCore home name

@@ -195,116 +208,28 @@ isLocal check (Canonical home name) =

195208

196209

197210

198−-- VARIABLE TO STRING

199−

200−

201−toString :: (ToText a) => a -> String

202−toString var =

203− Text.unpack (toText var)

204−

205−

206−class ToText a where

207− toText :: a -> Text

208−

209−

210−instance ToText Raw where

211− toText (Raw name) =

212− name

213−

214−

215−instance ToText Canonical where

216− toText (Canonical home name) =

217− case home of

218− BuiltIn ->

219− name

220−

221− Module moduleName ->

222− ModuleName.canonicalToText moduleName <> "." <> name

223−

224− TopLevel _ ->

225− name

226−

227− Local ->

228− name

229−

230−

231−

232−-- LISTINGS

233−

234−

235−-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)

236−data Listing a =

237− Listing

238− { _explicits :: [a]

239− , _open :: Bool

240− }

241− deriving (Eq, Ord)

242−

243−

244−openListing :: Listing a

245−openListing =

246− Listing [] True

247−

248−

249−closedListing :: Listing a

250−closedListing =

251− Listing [] False

252−

253−

254−listing :: [a] -> Listing a

255−listing xs =

256− Listing xs False

257−

258−

259−-- | A value that can be imported or exported

260−data Value

261− = Value !Text

262− | Alias !Text

263− | Union !Text !(Listing Text)

264− deriving (Eq, Ord)

265−

266−

267−

268−-- CATEGORIZING VALUES

269−

270−

271−getValues :: [Value] -> [Text]

272−getValues values =

273− Maybe.mapMaybe getValue values

274−

275−

276−getValue :: Value -> Maybe Text

277−getValue value =

278− case value of

279− Value name -> Just name

280− Alias _ -> Nothing

281− Union _ _ -> Nothing

211+-- VARIABLE TO TEXT

282212

283213

284−getAliases :: [Value] -> [Text]

285−getAliases values =

286− Maybe.mapMaybe getAlias values

214+rawToText :: Raw -> Text

215+rawToText (Raw name) =

216+ name

287217

288218

289−getAlias :: Value -> Maybe Text

290−getAlias value =

291− case value of

292− Value _-> Nothing

293− Alias name -> Just name

294− Union _ _ -> Nothing

295−

219+toText :: Canonical -> Text

220+toText (Canonical home name) =

221+ case home of

222+ BuiltIn ->

223+ name

296224

297−getUnions :: [Value] -> [(Text, Listing Text)]

298−getUnions values =

299− Maybe.mapMaybe getUnion values

225+ Module moduleName ->

226+ ModuleName.canonicalToText moduleName <> "." <> name

300227

228+ TopLevel _ ->

229+ name

301230

302−getUnion :: Value -> Maybe (Text, Listing Text)

303−getUnion value =

304− case value of

305− Value _ -> Nothing

306− Alias _ -> Nothing

307− Union name ctors -> Just (name, ctors)

231+ Local ->

232+ name

308233

309234

310235

@@ -312,53 +237,25 @@ getUnion value =

312237

313238

314239instance Binary Canonical where

315− put (Canonical home name) =

316− case home of

317− BuiltIn ->

318− putWord8 0 >> put name

319−

320− Module path ->

321− putWord8 1 >> put path >> put name

322−

323− TopLevel path ->

324− putWord8 2 >> put path >> put name

325−

326− Local ->

327− putWord8 3 >> put name

328−

329− get =

330− do tag <- getWord8

331− case tag of

332− 0 -> Canonical BuiltIn <$> get

333− 1 -> Canonical . Module <$> get <*> get

334− 2 -> Canonical . TopLevel <$> get <*> get

335− 3 -> Canonical Local <$> get

336− _ -> error "Unexpected tag when deserializing canonical variable"

337−

338−

339−instance Binary Value where

340− put portable =

341− case portable of

342− Value name ->

343− putWord8 0 >> put name

344−

345− Alias name ->

346− putWord8 1 >> put name

347−

348− Union name ctors ->

349− putWord8 2 >> put name >> put ctors

350−

351− get =

352− do tag <- getWord8

353− case tag of

354− 0 -> Value <$> get

355− 1 -> Alias <$> get

356− 2 -> Union <$> get <*> get

357− _ -> error "Error reading valid import/export information from serialized string"

240+ put (Canonical home name) =

241+ case home of

242+ BuiltIn ->

243+ putWord8 0 >> put name

358244

245+ Module path ->

246+ putWord8 1 >> put path >> put name

359247

360−instance (Binary a) => Binary (Listing a) where

361− put (Listing explicits open) =

362− put explicits >> put open

248+ TopLevel path ->

249+ putWord8 2 >> put path >> put name

363250

364− get = Listing <$> get <*> get

251+ Local ->

252+ putWord8 3 >> put name

253+

254+ get =

255+ do tag <- getWord8

256+ case tag of

257+ 0 -> Canonical BuiltIn <$> get

258+ 1 -> Canonical . Module <$> get <*> get

259+ 2 -> Canonical . TopLevel <$> get <*> get

260+ 3 -> Canonical Local <$> get

261+ _ -> error "Unexpected tag when deserializing canonical variable"

src/Canonicalize.hs+127−142

@@ -3,6 +3,7 @@ module Canonicalize (module') where

44import Prelude hiding (last)

55import qualified Data.Foldable as T

6+import Data.List.NonEmpty (NonEmpty((:|)))

67import qualified Data.List as List

78import qualified Data.Map as Map

89import qualified Data.Maybe as Maybe

@@ -10,6 +11,8 @@ import qualified Data.Set as Set

1011import Data.Text (Text)

1112

1213import qualified AST.Declaration as D

14+import qualified AST.Effects as Effects

15+import qualified AST.Exposing as Exposing

1316import qualified AST.Expression.Source as Src

1417import qualified AST.Expression.Canonical as C

1518import qualified AST.Module as Module

@@ -57,7 +60,7 @@ module' importDict interfaces modul =

5760 do env <- Setup.environment importDict interfaces modul

5861

5962 (,,,) env

60− <$> resolveExports (Effects.toValues effects ++ declsToValues decls) exports

63+ <$> resolveExports (getInternalApi effects decls) exports

6164 <*> canonicalizeDecls env decls

6265 <*> Effects.canonicalize env effects

6366 in

@@ -135,77 +138,98 @@ type CResult a =

135138-- EXPORTS

136139

137140

138−resolveExports :: [Var.Value] -> Var.Listing (A.Located Var.Value) -> CResult [Var.Value]

139−resolveExports fullList (Var.Listing partialList open) =

140− if open then

141− Result.ok fullList

142−

143− else

144− let

145− (allValues, allAliases, allAdts) =

146− maybeUnzip3 (map splitValue fullList)

147−

148− (values, aliases, adts) =

149− maybeUnzip3 (map splitLocatedValue partialList)

150−

151− adtTypes =

152− map fst allAdts

153− in

154− (\xs ys zs _ -> xs ++ ys ++ zs)

155− <$> traverse (getValueExport allValues (Set.fromList allValues)) values

156− <*> (concat <$> traverse (getAliasExport allValues allAliases adtTypes) aliases)

157− <*> traverse (getAdtExport allAdts adtTypes) adts

158− <*> allUnique partialList

159−

160−

161−getValueExport :: [Text] -> Set.Set Text -> A.Located Text -> CResult Var.Value

162−getValueExport allValues allValuesSet (A.A region name) =

163− if Set.member name allValuesSet then

164− Result.ok (Var.Value name)

165− else

166− manyNotFound region [name] allValues

167−

168−

169−getAliasExport :: [Text] -> [Text] -> [Text] -> A.Located Text -> CResult [Var.Value]

170−getAliasExport allValues allAliases adtTypes (A.A region alias) =

171− if alias `elem` allAliases then

172−

173− Result.ok $ (:) (Var.Alias alias) $

174− if alias `elem` allValues then [Var.Value alias] else []

175−

176− else if List.elem alias adtTypes then

177−

178− Result.ok [Var.Union alias (Var.Listing [] False)]

179−

180− else

181−

182− manyNotFound region [alias] (allAliases ++ adtTypes)

183−

184−

185−getAdtExport

186− :: [(Text, Var.Listing Text)]

187− -> [Text]

188− -> A.Located (Text, Var.Listing Text)

189− -> CResult Var.Value

190−getAdtExport allAdts adtTypes (A.A region (name, Var.Listing ctors open)) =

191− case List.lookup name allAdts of

192− Nothing ->

193− manyNotFound region [name] adtTypes

194−

195− Just (Var.Listing allCtors _) ->

196− if open then

197− Result.ok (Var.Union name (Var.Listing allCtors False))

198− else

199− case filter (`notElem` allCtors) ctors of

200− [] ->

201− Result.ok (Var.Union name (Var.Listing ctors False))

202− unfoundCtors ->

203− manyNotFound region unfoundCtors allCtors

141+resolveExports :: Exposing.Canonical -> Exposing.Raw -> CResult Exposing.Canonical

142+resolveExports internalApi@(Exposing.Canonical values aliases unions) rawExposing =

143+ case rawExposing of

144+ Exposing.Open ->

145+ Result.ok internalApi

146+

147+ Exposing.Explicit entries ->

148+ let

149+ valueSet = Set.fromList values

150+ aliasSet = Set.fromList aliases

151+ unionMap = Map.fromList unions

152+ in

153+ case List.foldl' (resolveEntry valueSet aliasSet unionMap) (Exposing.nothing, []) entries of

154+ (exposing, []) ->

155+ do checkForDups entries

156+ Result.ok exposing

157+

158+ (_, errors) ->

159+ Result.throwMany errors

160+

161+

162+resolveEntry

163+ :: Set.Set Text

164+ -> Set.Set Text

165+ -> Map.Map Text [Text]

166+ -> (Exposing.Canonical, [A.Located CError.Error])

167+ -> A.Located Exposing.Entry

168+ -> (Exposing.Canonical, [A.Located CError.Error])

169+resolveEntry vSet aSet uSet (exposing@(Exposing.Canonical values aliases unions), errors) (A.A region entry) =

170+ case entry of

171+ Exposing.Lower name ->

172+ if Set.member name vSet then

173+ ( Exposing.Canonical (name:values) aliases unions

174+ , errors

175+ )

204176

177+ else

178+ ( exposing

179+ , notFound region (Set.toList vSet) name : errors

180+ )

181+

182+ Exposing.Upper name Nothing ->

183+ if Set.member name aSet then

184+ ( Exposing.Canonical

185+ (if Set.member name vSet then name:values else values)

186+ (name:aliases)

187+ unions

188+ , errors

189+ )

190+

191+ else if Map.member name uSet then

192+ ( Exposing.Canonical values aliases ((name, []) : unions)

193+ , errors

194+ )

205195

206−manyNotFound :: Region.Region -> [Text] -> [Text] -> CResult a

207−manyNotFound region nameList possibilities =

208− Result.throwMany (map (notFound region possibilities) nameList)

196+ else

197+ ( exposing

198+ , notFound region (Set.toList aSet ++ Map.keys uSet) name : errors

199+ )

200+

201+ Exposing.Upper name (Just exposedCtors) ->

202+ case Map.lookup name uSet of

203+ Nothing ->

204+ ( exposing

205+ , notFound region (Map.keys uSet) name : errors

206+ )

207+

208+ Just allCtors ->

209+ case exposedCtors of

210+ Exposing.Open ->

211+ ( Exposing.Canonical values aliases ((name, allCtors) : unions)

212+ , errors

213+ )

214+

215+ Exposing.Explicit ctors ->

216+ let

217+ isNotKnown (A.A _ ctor) =

218+ ctor `notElem` allCtors

219+

220+ notKnown (A.A ctorRegion ctor) =

221+ notFound ctorRegion allCtors ctor

222+ in

223+ case filter isNotKnown ctors of

224+ [] ->

225+ ( Exposing.Canonical values aliases ((name, map A.drop ctors) : unions)

226+ , errors

227+ )

228+

229+ unfoundCtors ->

230+ ( exposing

231+ , map notKnown unfoundCtors ++ errors

232+ )

209233

210234

211235notFound :: Region.Region -> [Text] -> Text -> A.Located CError.Error

@@ -214,100 +238,61 @@ notFound region possibilities badName =

214238 Help.nearbyNames id badName possibilities

215239

216240

217−allUnique :: [A.Located Var.Value] -> CResult ()

218−allUnique statedExports =

241+checkForDups :: [A.Located Exposing.Entry] -> CResult ()

242+checkForDups entries =

219243 let

220− valueToText value =

221− case value of

222− Var.Value name -> name

223− Var.Alias name -> name

224− Var.Union name _ -> name

225−

226244 locations =

227− Map.fromListWith (++) (map (\(A.A region value) -> (value, [region])) statedExports)

245+ A.listToDict Exposing.getName entries

228246

229− isUnique value allRegions =

230− case allRegions of

231− region : _ : _ ->

232− Result.throw region (CError.DuplicateExport (valueToText value))

247+ isUnique name (region :| duplicates) =

248+ case duplicates of

249+ [] ->

250+ Result.ok ()

233251

234− _ ->

235− Result.ok ()

252+ _ ->

253+ Result.throw region (CError.DuplicateExport name)

236254 in

237255 T.sequenceA_ (Map.mapWithKey isUnique locations)

238256

239257

240258

241−-- CONVERSIONS

259+-- ALL POSSIBLE EXPOSED VALUES

242260

243261

244−declsToValues :: D.Valid -> [Var.Value]

245−declsToValues (D.Decls defs unions aliases _) =

262+getInternalApi :: Effects.Raw -> D.Valid -> Exposing.Canonical

263+getInternalApi effects (D.Decls defs unions aliases _) =

246264 let

247− fromDef (A.A _ def) =

248− map Var.Value (P.boundVarList (Src.getPattern def))

249−

250− fromUnion (A.A _ (D.Type name _ ctors)) =

251− Var.Union name (Var.Listing (map fst ctors) False)

252−

253− fromAlias (A.A _ (D.Type name _ tipe)) =

254− case tipe of

255− A.A _ (Type.RRecord _ Nothing) ->

256− [ Var.Alias name, Var.Value name ]

257−

258− _ ->

259− [ Var.Alias name ]

265+ values =

266+ Effects.toExposedValues effects

267+ ++ concatMap getAliasValues aliases

268+ ++ concatMap getDefValues defs

260269 in

261− concat

262− [ map fromUnion unions

263− , concatMap fromAlias aliases

264− , concatMap fromDef defs

265− ]

266−

267−

270+ Exposing.Canonical values (map getAlias aliases) (map getUnion unions)

268271

269−-- GROUPING VALUES

270−

271−

272−maybeUnzip3 :: [(Maybe a, Maybe b, Maybe c)] -> ([a],[b],[c])

273−maybeUnzip3 tuples =

274− let (as, bs, cs) = unzip3 tuples

275− in

276− (Maybe.catMaybes as, Maybe.catMaybes bs, Maybe.catMaybes cs)

277272

273+getDefValues :: A.Commented Src.ValidDef -> [Text]

274+getDefValues (A.A _ def) =

275+ P.boundVarList (Src.getPattern def)

278276

279−splitValue

280− :: Var.Value

281− -> ( Maybe Text, Maybe Text, Maybe (Text, Var.Listing Text) )

282−splitValue value =

283− case value of

284− Var.Value name ->

285− (Just name, Nothing, Nothing)

286277

287− Var.Alias name ->

288− (Nothing, Just name, Nothing)

278+getAliasValues :: A.Commented (D.Alias Type.Raw) -> [Text]

279+getAliasValues (A.A _ (D.Type name _ tipe)) =

280+ case tipe of

281+ A.A _ (Type.RRecord _ Nothing) ->

282+ [ name ]

289283

290− Var.Union name listing ->

291− (Nothing, Nothing, Just (name, listing))

284+ _ ->

285+ []

292286

293287

294−splitLocatedValue

295− :: A.Located Var.Value

296− ->

297− ( Maybe (A.Located Text)

298− , Maybe (A.Located Text)

299− , Maybe (A.Located (Text, Var.Listing Text))

300− )

301−splitLocatedValue (A.A region value) =

302− case value of

303− Var.Value name ->

304− (Just (A.A region name), Nothing, Nothing)

288+getAlias :: A.Commented (D.Alias Type.Raw) -> Text

289+getAlias (A.A _ (D.Type name _ _)) =

290+ name

305291

306− Var.Alias name ->

307− (Nothing, Just (A.A region name), Nothing)

308292

309− Var.Union name listing ->

310− (Nothing, Nothing, Just (A.A region (name, listing)))

293+getUnion :: A.Commented (D.Union Type.Raw) -> (Text, [Text])

294+getUnion (A.A _ (D.Type name _ ctors)) =

295+ (name, map fst ctors)

311296

312297

313298

src/Canonicalize/Effects.hs+9−4

@@ -1,6 +1,11 @@

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE OverloadedStrings #-}

3−module Canonicalize.Effects (canonicalize, toValues, checkPortType) where

3+module Canonicalize.Effects

4+ ( canonicalize

5+ , toExposedValues

6+ , checkPortType

7+ )

8+ where

510import qualified Data.Foldable as F

611import Data.Text (Text)

@@ -21,8 +26,8 @@ import Canonicalize.Variable (Result)

2126-- TO EXPORT VALUES

2227

2328

24−toValues :: Effects.Raw -> [Var.Value]

25−toValues effects =

29+toExposedValues :: Effects.Raw -> [Text]

30+toExposedValues effects =

2631 case effects of

2732 Effects.None ->

2833 []

@@ -31,7 +36,7 @@ toValues effects =

3136 []

3237

3338 Effects.Port ports ->

34− map (Var.Value . Effects._rawName . A.drop) ports

39+ map (Effects._rawName . A.drop) ports

3540

3641

3742

src/Canonicalize/Setup.hs+79−97

@@ -12,6 +12,7 @@ import Data.Text (Text)

1212

1313import qualified AST.Declaration as D

1414import qualified AST.Effects as Effects

15+import qualified AST.Exposing as Exposing

1516import qualified AST.Expression.Source as Src

1617import qualified AST.Module as Module

1718import qualified AST.Module.Name as ModuleName

@@ -66,10 +67,10 @@ environment importDict interfaces (Module.Module name info) =

6667

6768

6869importToPatches

69− :: Map.Map ModuleName.Raw ModuleName.Canonical

70− -> Module.Interfaces

71− -> A.Located (ModuleName.Raw, Module.ImportMethod)

72− -> Result [Env.Patch]

70+ :: Map.Map ModuleName.Raw ModuleName.Canonical

71+ -> Module.Interfaces

72+ -> A.Located (ModuleName.Raw, Module.ImportMethod)

73+ -> Result [Env.Patch]

7374importToPatches importDict allInterfaces (A.A region (rawImportName, method)) =

7475 let

7576 maybeInterface =

@@ -95,9 +96,6 @@ importToPatches importDict allInterfaces (A.A region (rawImportName, method)) =

9596 (Module.ImportMethod maybeAlias listing) =

9697 method

9798

98− (Var.Listing exposedValues open) =

99− listing

100−

10199 qualifier =

102100 maybe (ModuleName.toText rawImportName) id maybeAlias

103101

@@ -108,11 +106,12 @@ importToPatches importDict allInterfaces (A.A region (rawImportName, method)) =

108106 interfaceToPatches importName (qualifier <> ".") interface

109107

110108 unqualifiedPatches =

111− if open then

112− Result.ok (interfaceToPatches importName "" interface)

109+ case listing of

110+ Exposing.Open ->

111+ Result.ok (interfaceToPatches importName "" interface)

113112

114− else

115− concat <$> traverse (valueToPatches region importName interface) exposedValues

113+ Exposing.Explicit xs ->

114+ concat <$> traverse (entryToPatches importName interface) xs

116115 in

117116 (++) (infixPatches ++ qualifiedPatches) <$> unqualifiedPatches

118117

@@ -154,76 +153,76 @@ interfaceToPatches moduleName prefix interface =

154153

155154

156155

157−-- PATCHES FOR INDIVIDUAL VALUES

156+-- PATCHES FOR INDIVIDUAL ENTRIES

158157

159158

160−valueToPatches

161− :: R.Region

162− -> ModuleName.Canonical

163− -> Module.Interface

164− -> Var.Value

165− -> Result [Env.Patch]

166−valueToPatches region moduleName interface value =

159+entryToPatches

160+ :: ModuleName.Canonical

161+ -> Module.Interface

162+ -> A.Located Exposing.Entry

163+ -> Result [Env.Patch]

164+entryToPatches moduleName interface (A.A region entry) =

167165 let

168− patch mkPatch x =

169− mkPatch x (Var.fromModule moduleName x)

166+ patch mkPatch name =

167+ mkPatch name (Var.fromModule moduleName name)

170168

171− patternPatch (x, numArgs) =

172− Env.Pattern x (Var.fromModule moduleName x, numArgs)

169+ patternPatch (name, numArgs) =

170+ Env.Pattern name (Var.fromModule moduleName name, numArgs)

173171

174− notFound getNames x =

172+ notFound subRegion getNames name =

175173 Module.iExports interface

176174 |> getNames

177− |> Help.nearbyNames id x

178− |> Error.valueNotFound (ModuleName._module moduleName) x

179− |> Result.throw region

175+ |> Help.nearbyNames id name

176+ |> Error.valueNotFound (ModuleName._module moduleName) name

177+ |> Result.throw subRegion

180178 in

181− case value of

182− Var.Value x ->

183− if Map.notMember x (Module.iTypes interface) then

184− notFound Var.getValues x

179+ case entry of

180+ Exposing.Lower name ->

181+ if Map.notMember name (Module.iTypes interface) then

182+ notFound region Exposing._values name

185183

186184 else

187− Result.ok [patch Env.Value x]

185+ Result.ok [patch Env.Value name]

188186

189− Var.Alias x ->

187+ Exposing.Upper x Nothing ->

190188 case Map.lookup x (Module.iAliases interface) of

191189 Just (tvars, t) ->

192− let

193− alias =

194− Env.Alias x (Var.fromModule moduleName x, tvars, t)

195− in

196− Result.ok $

197− if Map.member x (Module.iTypes interface) then

198− [alias, patch Env.Value x]

190+ let

191+ alias =

192+ Env.Alias x (Var.fromModule moduleName x, tvars, t)

193+ in

194+ Result.ok $

195+ if Map.member x (Module.iTypes interface) then

196+ [alias, patch Env.Value x]

199197

200− else

201− [alias]

198+ else

199+ [alias]

202200

203201 Nothing ->

204− case Map.lookup x (Module.iUnions interface) of

205− Just (_,_) ->

206− Result.ok [patch Env.Union x]

207−

208− Nothing ->

209− let getNames values =

210− Var.getAliases values

211− ++ map fst (Var.getUnions values)

212− in

213− notFound getNames x

214−

215− Var.Union givenName (Var.Listing givenCtorNames open) ->

202+ case Map.lookup x (Module.iUnions interface) of

203+ Just (_,_) ->

204+ Result.ok [patch Env.Union x]

205+

206+ Nothing ->

207+ let getNames values =

208+ Exposing._aliases values

209+ ++ map fst (Exposing._unions values)

210+ in

211+ notFound region getNames x

212+

213+ Exposing.Upper givenName (Just exposing) ->

216214 case Map.lookup givenName (Module.iUnions interface) of

217215 Nothing ->

218− notFound (map fst . Var.getUnions) givenName

216+ notFound region (map fst . Exposing._unions) givenName

219217

220218 Just (_tvars, realCtors) ->

221− patches <$>

222− if open then

223− Result.ok realCtorList

219+ patches <$>

220+ case exposing of

221+ Exposing.Open ->

222+ Result.ok realCtorList

224223

225− else

226− traverse ctorExists givenCtorNames

224+ Exposing.Explicit xs ->

225+ traverse ctorExists xs

227226 where

228227 realCtorList =

229228 map (second length) realCtors

@@ -231,13 +230,13 @@ valueToPatches region moduleName interface value =

231230 realCtorDict =

232231 Map.fromList realCtorList

233232

234− ctorExists givenCtorName =

233+ ctorExists (A.A ctorRegion givenCtorName) =

235234 case Map.lookup givenCtorName realCtorDict of

236235 Just numArgs ->

237− Result.ok (givenCtorName, numArgs)

236+ Result.ok (givenCtorName, numArgs)

238237

239238 Nothing ->

240− notFound (const (map fst realCtors)) givenCtorName

239+ notFound ctorRegion (const (map fst realCtors)) givenCtorName

241240

242241 patches ctors =

243242 patch Env.Union givenName

@@ -406,35 +405,21 @@ effectsToPatches moduleName effects =

406405

407406restrictToPublicApi :: Module.Interface -> Module.Interface

408407restrictToPublicApi interface =

408+ let

409+ (Exposing.Canonical values aliases unions) =

410+ Module.iExports interface

411+ in

409412 interface

410− { Module.iTypes =

411− Map.fromList $

412− Maybe.mapMaybe

413− (get (Module.iTypes interface))

414− (Var.getValues exports ++ ctors)

415−

416− , Module.iAliases =

417− Map.fromList $

418− Maybe.mapMaybe

419− (get (Module.iAliases interface))

420− (Var.getAliases exports)

421−

422− , Module.iUnions =

423− Map.fromList

424− (Maybe.mapMaybe (trimUnions interface) unions)

425− }

426− where

427− exports :: [Var.Value]

428− exports =

429− Module.iExports interface

413+ { Module.iTypes = Map.fromList $

414+ Maybe.mapMaybe (get (Module.iTypes interface)) (values ++ concatMap snd unions)

430415

431− unions :: [(Text, Var.Listing Text)]

432− unions =

433− Var.getUnions exports

416+ , Module.iAliases = Map.fromList $

417+ Maybe.mapMaybe (get (Module.iAliases interface)) aliases

418+

419+ , Module.iUnions = Map.fromList $

420+ Maybe.mapMaybe (trimUnions interface) unions

421+ }

434422

435− ctors :: [Text]

436− ctors =

437− concatMap (\(_, Var.Listing ctorList _) -> ctorList) unions

438423

439424

440425get :: Map.Map Text a -> Text -> Maybe (Text, a)

@@ -447,18 +432,15 @@ get dict key =

447432 Just (key, value)

448433

449434

450−trimUnions

451− :: Module.Interface

452− -> (Text, Var.Listing Text)

453− -> Maybe (Text, Module.UnionInfo Text)

454−trimUnions interface (name, Var.Listing exportedCtors _) =

435+trimUnions :: Module.Interface -> (Text, [Text]) -> Maybe (Text, Module.UnionInfo Text)

436+trimUnions interface (name, exposedCtors) =

455437 case Map.lookup name (Module.iUnions interface) of

456438 Nothing ->

457439 Nothing

458440

459441 Just (tvars, ctors) ->

460442 let

461− isExported (ctor, _) =

462− ctor `elem` exportedCtors

443+ isExposed (ctor, _) =

444+ ctor `elem` exposedCtors

463445 in

464− Just (name, (tvars, filter isExported ctors))

446+ Just (name, (tvars, filter isExposed ctors))

src/Docs/AST.hs+64−19

@@ -1,4 +1,12 @@

1−module Docs.AST where

1+{-# OPTIONS_GHC -Wall #-}

2+module Docs.AST

3+ ( Centralized(..), Checked(..)

4+ , Value(..), RawValue, GoodValue

5+ , Alias(..), RawAlias, GoodAlias

6+ , Union(..), RawUnion, GoodUnion

7+ )

8+ where

210

311import qualified Data.Map as Map

412import Data.Text (Text)

@@ -7,40 +15,77 @@ import qualified Elm.Compiler.Type as Type

715import qualified Reporting.Annotation as A

816

917

10−-- FULL DOCUMENTATION

1118

12−data Docs t =

13− Docs

19+-- DOCS

20+

21+

22+data Centralized =

23+ Centralized

1424 { comment :: Text

15− , aliases :: Map.Map Text (A.Located Alias)

16− , types :: Map.Map Text (A.Located Union)

17− , values :: Map.Map Text (A.Located (Value t))

25+ , values :: Map.Map Text (A.Located RawValue)

26+ , aliases :: Map.Map Text (A.Located RawAlias)

27+ , unions :: Map.Map Text (A.Located RawUnion)

28+ }

29+

30+

31+data Checked =

32+ Checked

33+ { _comment :: Text

34+ , _values :: Map.Map Text GoodValue

35+ , _aliases :: Map.Map Text GoodAlias

36+ , _unions :: Map.Map Text GoodUnion

37+ }

38+

39+

40+

41+-- VALUES

42+

43+

44+data Value comment tipe =

45+ Value

46+ { valueComment :: comment

47+ , valueType :: tipe

48+ , valueAssocPrec :: Maybe (Text,Int)

1849 }

1950

2051

21−type Centralized = Docs (Maybe Type.Type)

52+type RawValue = Value (Maybe Text) (Maybe Type.Type)

53+

2254

23−type Checked = Docs Type.Type

55+type GoodValue = Value Text Type.Type

2456

2557

26−-- VALUE DOCUMENTATION

2758

28−data Alias = Alias

29− { aliasComment :: Maybe Text

59+-- ALIAS

60+

61+

62+data Alias comment =

63+ Alias

64+ { aliasComment :: comment

3065 , aliasArgs :: [Text]

3166 , aliasType :: Type.Type

3267 }

3368

3469

35−data Union = Union

36− { unionComment :: Maybe Text

70+type RawAlias = Alias (Maybe Text)

71+

72+

73+type GoodAlias = Alias Text

74+

75+

76+

77+-- UNION

78+

79+

80+data Union comment =

81+ Union

82+ { unionComment :: comment

3783 , unionArgs :: [Text]

3884 , unionCases :: [(Text, [Type.Type])]

3985 }

4086

4187

42−data Value t = Value

43− { valueComment :: Maybe Text

44− , valueType :: t

45− , valueAssocPrec :: Maybe (Text,Int)

46− }

88+type RawUnion = Union (Maybe Text)

89+

90+

91+type GoodUnion = Union Text

src/Docs/Centralize.hs+5−6

@@ -10,7 +10,6 @@ import qualified AST.Expression.Canonical as Canonical

1010import qualified AST.Pattern as Pattern

1111import qualified AST.Type as Type

1212import qualified Docs.AST as Docs

13−import qualified Elm.Compiler.Type as Type

1413import qualified Elm.Compiler.Type.Extract as Extract

1514import qualified Reporting.Annotation as A

1615

@@ -25,11 +24,11 @@ centralize (D.Decls defs unions aliases infixes) comment =

2524 infixDict =

2625 Map.fromList (map infixToEntry infixes)

2726 in

28− Docs.Docs

27+ Docs.Centralized

2928 comment

29+ (Map.fromList (Maybe.mapMaybe (defToEntry infixDict) defs))

3030 (Map.fromList (map aliasToEntry aliases))

3131 (Map.fromList (map unionToEntry unions))

32− (Map.fromList (Maybe.mapMaybe (defToEntry infixDict) defs))

3332

3433

3534

@@ -39,7 +38,7 @@ centralize (D.Decls defs unions aliases infixes) comment =

3938defToEntry

4039 :: Map.Map Text (Text, Int)

4140 -> A.Commented Canonical.Def

42− -> Maybe (Text, A.Located (Docs.Value (Maybe Type.Type)))

41+ -> Maybe (Text, A.Located Docs.RawValue)

4342defToEntry infixDict (A.A (_, maybeComment) (Canonical.Def _ pattern _ maybeType)) =

4443 case pattern of

4544 A.A subregion (Pattern.Var name) ->

@@ -56,7 +55,7 @@ defToEntry infixDict (A.A (_, maybeComment) (Canonical.Def _ pattern _ maybeType

5655 Nothing

5756

5857

59−unionToEntry :: A.Commented (D.Union Type.Canonical) -> (Text, A.Located Docs.Union)

58+unionToEntry :: A.Commented (D.Union Type.Canonical) -> (Text, A.Located Docs.RawUnion)

6059unionToEntry (A.A (region, maybeComment) (D.Type name args ctors)) =

6160 let

6261 ctors' =

@@ -65,7 +64,7 @@ unionToEntry (A.A (region, maybeComment) (D.Type name args ctors)) =

6564 (name, A.A region (Docs.Union maybeComment args ctors'))

6665

6766

68−aliasToEntry :: A.Commented (D.Alias Type.Canonical) -> (Text, A.Located Docs.Alias)

67+aliasToEntry :: A.Commented (D.Alias Type.Canonical) -> (Text, A.Located Docs.RawAlias)

6968aliasToEntry (A.A (region, maybeComment) (D.Type name args tipe)) =

7069 ( name

7170 , A.A region (Docs.Alias maybeComment args (Extract.extract tipe))

src/Docs/Check.hs+112−98

@@ -1,14 +1,18 @@

1−module Docs.Check (check) where

1+{-# OPTIONS_GHC -Wall #-}

2+module Docs.Check

3+ ( check

4+ )

5+ where

3−import qualified Data.List as List

8+import Data.List.NonEmpty (NonEmpty((:|)))

49import qualified Data.Map as Map

510import qualified Data.Set as Set

611import Data.Text (Text)

712

8−import qualified AST.Variable as Var

13+import qualified AST.Exposing as Exposing

914import qualified Docs.AST as Docs

1015import qualified Elm.Compiler.Type as Type

11−import Elm.Utils ((|>))

1216import qualified Reporting.Annotation as A

1317import qualified Reporting.Error as Error

1418import qualified Reporting.Error.Docs as E

@@ -24,10 +28,10 @@ import Parse.Helpers

2428

2529

2630

27−-- CHECK DOCUMENTATION

31+-- CHECK

2832

2933

30−check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> R.Result () w Error.Error Docs.Checked

34+check :: Exposing.Canonical -> A.Located (Maybe Docs.Centralized) -> R.Result () w Error.Error Docs.Checked

3135check exports (A.A region maybeDocs) =

3236 case maybeDocs of

3337 Nothing ->

@@ -37,122 +41,141 @@ check exports (A.A region maybeDocs) =

3741 checkHelp region exports docs

3842

3943

40−checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> R.Result () w Error.Error Docs.Checked

41−checkHelp region exports (Docs.Docs comment aliases types values) =

44+checkHelp :: R.Region -> Exposing.Canonical -> Docs.Centralized -> R.Result () w Error.Error Docs.Checked

45+checkHelp region exposing (Docs.Centralized comment values aliases unions) =

46+ do docNames <- parseNames region comment

47+

48+ let docSet = Set.fromList (map A.drop docNames)

49+ let restrict checker dict =

50+ Map.traverseWithKey checker (Map.restrictKeys dict docSet)

51+

52+ R.mapError Error.Docs $

53+ Docs.Checked comment

54+ <$> restrict checkValue values

55+ <*> restrict checkAlias aliases

56+ <*> restrict (checkUnion exposing) unions

57+ <* checkCommentNames region exposing docNames

58+

59+

60+

61+-- CHECK COMMENT NAMES

62+

63+

64+type Result w a = R.Result () w E.Error a

65+

66+

67+checkCommentNames :: R.Region -> Exposing.Canonical -> [A.Located Text] -> Result w ()

68+checkCommentNames region (Exposing.Canonical values aliases unions) docNames =

4269 let

43− exportedUnions =

44− map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)

70+ addUnit name =

71+ ( name, () )

72+

73+ exposed =

74+ Map.fromList $ map addUnit $

75+ values ++ aliases ++ map fst unions

76+

77+ docDict =

78+ A.listToDict id docNames

4579 in

46− do docNames <- parseNames region comment

47− let docSet = Set.fromList (map A.drop docNames)

48− R.mapError Error.Docs $

49− (\() -> Docs.Docs comment)

50− <$> checkModuleComment region exports docNames

51− <*> checkCategory docSet (checkComment Docs.aliasComment) aliases

52− <*> checkCategory docSet (checkUnion exportedUnions) types

53− <*> checkCategory docSet checkValue values

80+ checkOnlyInExports region (Map.difference exposed docDict)

81+ <* Map.traverseMaybeWithKey (checkDocName exposed) docDict

5482

5583

56−type Result w a = R.Result () w E.Error a

84+checkOnlyInExports :: R.Region -> Map.Map Text () -> Result w ()

85+checkOnlyInExports region onlyInExports =

86+ case Map.keys onlyInExports of

87+ [] ->

88+ R.ok ()

5789

90+ names ->

91+ R.throw region (E.OnlyInExports names)

5892

59−checkCategory

60− :: Set.Set Text

61− -> (Text -> a -> Result w b)

62− -> Map.Map Text a

63− -> Result w (Map.Map Text b)

64−checkCategory docSet checker dict =

65− dict

66− |> Map.filterWithKey (\key _ -> Set.member key docSet)

67− |> Map.mapWithKey checker

68− |> traverse id

6993

94+checkDocName :: Map.Map Text () -> Text -> NonEmpty R.Region -> Result w (Maybe a)

95+checkDocName exposed name (region :| duplicates) =

96+ case duplicates of

97+ [] ->

98+ if Map.member name exposed then

99+ R.ok Nothing

70100

71−checkComment :: (a -> Maybe Text) -> Text -> A.Located a -> Result w (A.Located a)

72−checkComment getComment name (A.A region value) =

73− case getComment value of

74− Nothing ->

75− R.throw region (E.NoComment name)

101+ else

102+ R.throw region $ E.OnlyInDocs name $

103+ Help.nearbyNames id name (Map.keys exposed)

76104

77− Just _ ->

78− R.ok (A.A region value)

105+ _ ->

106+ R.throw region (E.Duplicates name)

79107

80108

81−checkUnion :: [(Text, [Text])] -> Text -> A.Located Docs.Union -> Result w (A.Located Docs.Union)

82−checkUnion exportedUnions name value =

83− const

84− <$> filterUnionTags exportedUnions name value

85− <*> checkComment Docs.unionComment name value

86109

110+-- CHECK COMMENT

87111

88−filterUnionTags :: [(Text, [Text])] -> Text -> A.Located Docs.Union -> Result w (A.Located Docs.Union)

89−filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =

90− let

91− exportedTags =

92− maybe [] id (List.lookup name exportedUnions)

93− in

94− R.ok $ A.A region $ union

95− { Docs.unionCases =

96− filter (\(tag, _) -> elem tag exportedTags) ctors

97− }

98112

113+checkComment :: R.Region -> Text -> Maybe Text -> Result w Text

114+checkComment region name maybeComment =

115+ case maybeComment of

116+ Just comment ->

117+ R.ok comment

118+

119+ Nothing ->

120+ R.throw region (E.NoComment name)

99121

100122

101−checkValue :: Text -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))

102−checkValue name value =

103− const

104− <$> hasType name value

105− <*> checkComment Docs.valueComment name value

106123

124+-- CHECK VALUE

107125

108−hasType :: Text -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))

109−hasType name (A.A region value) =

110− case Docs.valueType value of

126+

127+checkValue :: Text -> A.Located Docs.RawValue -> Result w Docs.GoodValue

128+checkValue name (A.A region (Docs.Value comment tipe assocPrec)) =

129+ Docs.Value

130+ <$> checkComment region name comment

131+ <*> checkValueType region name tipe

132+ <*> pure assocPrec

133+

134+

135+checkValueType :: R.Region -> Text -> Maybe Type.Type -> Result w Type.Type

136+checkValueType region name maybeType =

137+ case maybeType of

111138 Just tipe ->

112− R.ok (A.A region (value { Docs.valueType = tipe }))

139+ R.ok tipe

113140

114141 Nothing ->

115− R.throw region (E.NoType name)

142+ R.throw region (E.NoType name)

116143

117144

118145

119−-- CHECK MODULE COMMENT

146+-- CHECK ALIAS

120147

121148

122−checkModuleComment :: R.Region -> [Var.Value] -> [A.Located Text] -> Result w ()

123−checkModuleComment docRegion exports locatedDocNames =

124− let

125− exportNames =

126− map valueName exports

149+checkAlias :: Text -> A.Located Docs.RawAlias -> Result w Docs.GoodAlias

150+checkAlias name (A.A region (Docs.Alias comment args tipe)) =

151+ Docs.Alias

152+ <$> checkComment region name comment

153+ <*> pure args

154+ <*> pure tipe

127155

128− exportDict =

129− Map.fromList (map (\name -> (name, ())) exportNames)

130156

131− docDict =

132− Map.fromList (map (\(A.A region name) -> (name, region)) locatedDocNames)

133157

134− extraNameError (name, region) =

135− R.throw region (E.OnlyInDocs name (Help.nearbyNames id name exportNames))

158+-- CHECK UNION

136159

137− docErrors =

138− Map.difference docDict exportDict

139− |> Map.toList

140− |> traverse extraNameError

141160

142− namesOnlyInExports =

143− Map.difference exportDict docDict

144− |> Map.toList

145− |> map fst

161+checkUnion :: Exposing.Canonical -> Text -> A.Located Docs.RawUnion -> Result w Docs.GoodUnion

162+checkUnion (Exposing.Canonical _ _ unions) name (A.A region (Docs.Union comment args ctors)) =

163+ Docs.Union

164+ <$> checkComment region name comment

165+ <*> pure args

166+ <*> checkUnionCtors (Map.fromList unions) name ctors

146167

147− exportErrors =

148− if null namesOnlyInExports then

149− R.ok ()

150− else

151− R.throw docRegion (E.OnlyInExports namesOnlyInExports)

168+

169+checkUnionCtors :: Map.Map Text [Text] -> Text -> [(Text, [Type.Type])] -> Result w [(Text, [Type.Type])]

170+checkUnionCtors unions name ctors =

171+ let

172+ publicCtors =

173+ maybe [] id (Map.lookup name unions)

174+

175+ isPublic (ctor, _) =

176+ ctor `elem` publicCtors

152177 in

153− (\_ _ -> ())

154− <$> exportErrors

155− <*> docErrors

178+ R.ok $ filter isPublic ctors

156179

157180

158181

@@ -169,7 +192,6 @@ parseNames (R.Region (R.Position row col) _) comment =

169192 R.ok names

170193

171194

172−

173195namesParser :: [A.Located Text] -> Parser [A.Located Text]

174196namesParser names =

175197 do isDocs <- chompUntilDocs

@@ -204,11 +226,3 @@ operator =

204226 op <- infixOp

205227 rightParen

206228 return op

207−

208−

209−valueName :: Var.Value -> Text

210−valueName value =

211− case value of

212− Var.Value name -> name

213− Var.Alias name -> name

214− Var.Union name _ -> name

src/Elm/Compiler/Imports.hs+30−17

@@ -4,42 +4,55 @@ module Elm.Compiler.Imports (defaults) where

55import Data.Text (Text)

7+import qualified AST.Exposing as E

78import qualified AST.Module as Module

8−import qualified AST.Variable as Var

9+import qualified Reporting.Annotation as A

10+import qualified Reporting.Region as R

11+

912

1013

1114-- DEFAULT IMPORTS

1215

16+

1317(==>) :: a -> b -> (a,b)

1418(==>) = (,)

1519

1620

1721defaults :: [Module.DefaultImport]

1822defaults =

19− [ "Basics" ==> Module.ImportMethod Nothing Var.openListing

20− , "Debug" ==> Module.ImportMethod Nothing Var.closedListing

21− , "List" ==> exposing [Var.Value "::"]

22− , "Maybe" ==> exposing [Var.Union "Maybe" Var.openListing]

23− , "Result" ==> exposing [Var.Union "Result" Var.openListing]

24− , "String" ==> Module.ImportMethod Nothing Var.closedListing

25− , "Tuple" ==> Module.ImportMethod Nothing Var.closedListing

23+ [ "Basics" ==> Module.ImportMethod Nothing E.Open

24+ , "Debug" ==> Module.ImportMethod Nothing E.closed

25+ , "List" ==> exposing [E.Lower "::"]

26+ , "Maybe" ==> exposing [E.Upper "Maybe" (Just E.Open)]

27+ , "Result" ==> exposing [E.Upper "Result" (Just E.Open)]

28+ , "String" ==> Module.ImportMethod Nothing E.closed

29+ , "Tuple" ==> Module.ImportMethod Nothing E.closed

2630 , "Platform" ==> exposing [closedType "Program"]

27− , "Platform.Cmd" ==> named "Cmd" [closedType "Cmd", Var.Value "!"]

31+ , "Platform.Cmd" ==> named "Cmd" [closedType "Cmd", E.Lower "!"]

2832 , "Platform.Sub" ==> named "Sub" [closedType "Sub"]

2933 ]

3034

3135

32−exposing :: [Var.Value] -> Module.ImportMethod

33−exposing vars =

34− Module.ImportMethod Nothing (Var.listing vars)

36+exposing :: [E.Entry] -> Module.ImportMethod

37+exposing entries =

38+ Module.ImportMethod Nothing (explicit entries)

3539

3640

37−closedType :: Text -> Var.Value

41+closedType :: Text -> E.Entry

3842closedType name =

39− Var.Union name Var.closedListing

43+ E.Upper name Nothing

44+

45+

46+named :: Text -> [E.Entry] -> Module.ImportMethod

47+named name entries =

48+ Module.ImportMethod (Just name) (explicit entries)

49+

4050

51+explicit :: [E.Entry] -> E.Raw

52+explicit entries =

53+ E.Explicit (map (A.A nowhere) entries)

4154

42−named :: Text -> [Var.Value] -> Module.ImportMethod

43−named name vars =

44− Module.ImportMethod (Just name) (Var.listing vars)

4555

56+nowhere :: R.Region

57+nowhere =

58+ R.Region (R.Position 1 1) (R.Position 1 1)

src/Elm/Compiler/Type.hs+1−1

@@ -215,7 +215,7 @@ fromRawType (A.A _ astType) =

215215 Var x

216216

217217 Type.RType var ->

218− Type (Var.toText var)

218+ Type (Var.rawToText var)

219219

220220 Type.RApp t ts ->

221221 App (fromRawType t) (map fromRawType ts)

src/Elm/Docs.hs+7−11

@@ -16,7 +16,6 @@ import qualified Elm.Compiler.Module as Module

1616import qualified Elm.Compiler.Type as Type

1717import qualified Elm.Compiler.Version as Version

1818import qualified Elm.Package as Pkg

19−import qualified Reporting.Annotation as A

2019

2120

2221

@@ -69,19 +68,16 @@ data Version = NonCanonicalTypes | Version Text

6968

7069

7170fromCheckedDocs :: Module.Raw -> Docs.Checked -> Documentation

72−fromCheckedDocs name (Docs.Docs comment aliases unions values) =

71+fromCheckedDocs name (Docs.Checked comment values aliases unions) =

7372 let

74− unwrap cmnt =

75− maybe "" id cmnt

73+ toValue (name, Docs.Value comment tipe fix) =

74+ Value name comment tipe fix

7675

77− toAlias (name, (A.A _ (Docs.Alias cmnt args tipe))) =

78− Alias name (unwrap cmnt) args tipe

76+ toAlias (name, Docs.Alias comment args tipe) =

77+ Alias name comment args tipe

7978

80− toUnion (name, (A.A _ (Docs.Union cmnt args cases))) =

81− Union name (unwrap cmnt) args cases

82−

83− toValue (name, (A.A _ (Docs.Value cmnt tipe fix))) =

84− Value name (unwrap cmnt) tipe fix

79+ toUnion (name, Docs.Union comment args cases) =

80+ Union name comment args cases

8581 in

8682 Documentation

8783 name

src/Nitpick/Pattern.hs+2−2

@@ -70,7 +70,7 @@ toText pattern =

7070toBuilder :: Bool -> Pattern -> Builder

7171toBuilder needsParens pattern =

7272 case pattern of

73− Ctor tag [first,rest] | Var.toText tag == "::" ->

73+ Ctor tag [first,rest] | Var.isCons tag ->

7474 toBuilder (isCons first) first <> " :: " <> toBuilder False rest

7575

7676 Ctor tag args ->

@@ -104,7 +104,7 @@ isCons :: Pattern -> Bool

104104isCons pattern =

105105 case pattern of

106106 Ctor tag [_,_] ->

107− Var.toText tag == "::"

107+ Var.isCons tag

108108

109109 _ ->

110110 False

src/Parse/Module.hs+25−24

@@ -4,8 +4,8 @@ module Parse.Module where

55import Data.Text (Text)

7+import qualified AST.Exposing as Exposing

78import qualified AST.Module as Module

8−import qualified AST.Variable as Var

99import Parse.Helpers

1010import qualified Reporting.Annotation as A

1111import qualified Reporting.Error.Syntax as E

@@ -45,7 +45,7 @@ headerDecl =

4545 settings <- effectSettings

4646 hint E.Exposing $ keyword "exposing"

4747 spaces

48− exports <- listing (addLocation listingValue)

48+ exports <- exposing exposingEntry

4949 popContext ()

5050 docs <- maybeDocComment

5151 return (Module.HeaderDecl tag name exports settings docs)

@@ -156,7 +156,7 @@ chompImports imports =

156156 pos <- whitespace

157157 oneOf

158158 [ do checkFreshLine pos

159− let userImport = method start end name Nothing Var.closedListing

159+ let userImport = method start end name Nothing Exposing.closed

160160 popContext ()

161161 chompImports (userImport:imports)

162162 , do checkSpace pos

@@ -178,7 +178,7 @@ chompAs start name imports =

178178 pos <- whitespace

179179 oneOf

180180 [ do checkFreshLine pos

181− let userImport = method start end name (Just alias) Var.closedListing

181+ let userImport = method start end name (Just alias) (Exposing.Explicit [])

182182 popContext ()

183183 chompImports (userImport:imports)

184184 , do checkSpace pos

@@ -190,7 +190,7 @@ chompExposing :: R.Position -> Text -> Maybe Text -> [Module.UserImport] -> Pars

190190chompExposing start name maybeAlias imports =

191191 do keyword "exposing"

192192 spaces

193− exposed <- listing listingValue

193+ exposed <- exposing exposingEntry

194194 end <- getPosition

195195 freshLine

196196 let userImport = method start end name maybeAlias exposed

@@ -198,7 +198,7 @@ chompExposing start name maybeAlias imports =

198198 chompImports (userImport:imports)

199199

200200

201−method :: R.Position -> R.Position -> Text -> Maybe Text -> Var.Listing Var.Value -> Module.UserImport

201+method :: R.Position -> R.Position -> Text -> Maybe Text -> Exposing.Raw -> Module.UserImport

202202method start end name maybeAlias exposed =

203203 A.at start end ( name, Module.ImportMethod maybeAlias exposed )

204204

@@ -207,8 +207,8 @@ method start end name maybeAlias exposed =

207207-- LISTING

208208

209209

210−listing :: Parser a -> Parser (Var.Listing a)

211−listing parser =

210+exposing :: Parser a -> Parser (Exposing.Exposing a)

211+exposing parser =

212212 hint E.Listing $

213213 do leftParen

214214 spaces

@@ -217,40 +217,41 @@ listing parser =

217217 dot

218218 spaces

219219 rightParen

220− return (Var.Listing [] True)

221− , do value <- parser

220+ return Exposing.Open

221+ , do value <- addLocation parser

222222 spaces

223− listingHelp parser [value]

223+ exposingHelp parser [value]

224224 ]

225225

226226

227−listingHelp :: Parser a -> [a] -> Parser (Var.Listing a)

228−listingHelp parser values =

227+exposingHelp :: Parser a -> [A.Located a] -> Parser (Exposing.Exposing a)

228+exposingHelp parser values =

229229 oneOf

230230 [ do comma

231231 spaces

232− value <- parser

232+ value <- addLocation parser

233233 spaces

234− listingHelp parser (value:values)

234+ exposingHelp parser (value:values)

235235 , do rightParen

236− return (Var.Listing (reverse values) False)

236+ return (Exposing.Explicit (reverse values))

237237 ]

238238

239239

240−listingValue :: Parser Var.Value

241−listingValue =

240+exposingEntry :: Parser Exposing.Entry

241+exposingEntry =

242242 oneOf

243− [ Var.Value <$> lowVar

243+ [ Exposing.Lower <$> lowVar

244244 , do leftParen

245245 op <- infixOp

246246 rightParen

247− return (Var.Value op)

247+ return (Exposing.Lower op)

248248 , do name <- capVar

249249 spaces

250− oneOf

251− [ Var.Union name <$> listing capVar

252− , return (Var.Alias name)

253− ]

250+ Exposing.Upper name <$>

251+ oneOf

252+ [ Just <$> exposing capVar

253+ , return Nothing

254+ ]

254255 ]

255256

256257

src/Reporting/Annotation.hs+39−13

@@ -1,6 +1,20 @@

1−module Reporting.Annotation where

2−

3−import Prelude hiding (map)

1+{-# OPTIONS_GHC -Wall #-}

2+module Reporting.Annotation

3+ ( Annotated(..)

4+ , Located

5+ , Commented

6+ , at, merge, sameAs

7+ , map, drop

8+ , listToDict

9+ )

10+ where

11+

12+

13+import Prelude hiding (drop, map)

14+import qualified Data.List as List

15+import Data.List.NonEmpty (NonEmpty((:|)))

16+import qualified Data.Map as Map

17+import Data.Semigroup ((<>))

418import Data.Text (Text)

519import qualified Reporting.Region as R

620

@@ -9,16 +23,16 @@ import qualified Reporting.Region as R

923-- ANNOTATION

1024

1125

12−data Annotated annotation a

13− = A annotation a

26+data Annotated annotation a =

27+ A annotation a

1428

1529

1630type Located a =

17− Annotated R.Region a

31+ Annotated R.Region a

1832

1933

2034type Commented a =

21− Annotated (R.Region, Maybe Text) a

35+ Annotated (R.Region, Maybe Text) a

2236

2337

2438

@@ -27,17 +41,17 @@ type Commented a =

2741

2842at :: R.Position -> R.Position -> a -> Located a

2943at start end value =

30− A (R.Region start end) value

44+ A (R.Region start end) value

3145

3246

3347merge :: Located a -> Located b -> value -> Located value

3448merge (A region1 _) (A region2 _) value =

35− A (R.merge region1 region2) value

49+ A (R.merge region1 region2) value

3650

3751

3852sameAs :: Annotated info a -> b -> Annotated info b

3953sameAs (A annotation _) value =

40− A annotation value

54+ A annotation value

4155

4256

4357

@@ -45,11 +59,23 @@ sameAs (A annotation _) value =

4559

4660

4761map :: (a -> b) -> Annotated info a -> Annotated info b

48−map f (A annotation value) =

49− A annotation (f value)

62+map f (A info value) =

63+ A info (f value)

5064

5165

5266drop :: Annotated info a -> a

5367drop (A _ value) =

54− value

68+ value

69+

70+

71+

72+-- ANALYZE

73+

5574

75+listToDict :: (Ord key) => (a -> key) -> [Annotated i a] -> Map.Map key (NonEmpty i)

76+listToDict toKey list =

77+ let

78+ add dict (A info value) =

79+ Map.insertWith (<>) (toKey value) (info :| []) dict

80+ in

81+ List.foldl' add Map.empty list

src/Reporting/Error/Docs.hs+12−2

@@ -14,6 +14,7 @@ data Error

1414 = NoDocs

1515 | OnlyInDocs Text [Text]

1616 | OnlyInExports [Text]

17+ | Duplicates Text

1718 | NoComment Text

1819 | NoType Text

1920

@@ -58,11 +59,20 @@ toReport err =

5859 <> "Learn more at <http://package.elm-lang.org/help/documentation-format>"

5960 )

6061

62+ Duplicates name ->

63+ Report.report

64+ "DOCUMENTATION ERROR"

65+ Nothing

66+ ( "There can only be one `" <> name <> "` in your module documentation."

67+ )

68+ ( text "Remove one of them!"

69+ )

70+

6171 NoComment name ->

6272 Report.report

6373 "DOCUMENTATION ERROR"

6474 Nothing

65− ("The value `" <> name <> "` does not have a documentation comment.")

75+ ("The `" <> name <> "` definition does not have a documentation comment.")

6676 ( text "Learn more at <http://package.elm-lang.org/help/documentation-format>"

6777 )

6878

@@ -70,7 +80,7 @@ toReport err =

7080 Report.report

7181 "MISSING ANNOTATION"

7282 Nothing

73− ("The value `" <> name <> "` does not have a type annotation.")

83+ ("The `" <> name <> "` definition does not have a type annotation.")

7484 ( text $

7585 "Adding type annotations is best practice and it gives you a chance to name\n"

7686 <> "types and type variables so they are as easy as possible to understand!"