fe1d53a · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Refactor representation of "exposing" and documentation

fe1d53aEvan Czaplicki10 years ago

elm-compiler.cabal+2

compare with master

unifiedsplit

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

58 other-modules:

59 AST.Declaration,

60 AST.Effects,

61+ AST.Exposing,

61 AST.Expression.Canonical,

62 AST.Expression.Canonical,

62 AST.Expression.Optimized,

63 AST.Expression.Optimized,

63 AST.Expression.Source,

64 AST.Expression.Source,

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

154 parsec,

155 parsec,

155 pretty >= 1.0 && < 2.0,

156 pretty >= 1.0 && < 2.0,

156 process,

157 process,

158+ semigroups,

157 text >= 1 && < 2,

159 text >= 1 && < 2,

158 union-find >= 0.2 && < 0.3

160 union-find >= 0.2 && < 0.3

159

161

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)

25import qualified AST.Declaration as Decl

26import qualified AST.Effects as Effects

27+import qualified AST.Exposing as Exposing

27import qualified AST.Expression.Canonical as Canonical

28import qualified AST.Expression.Canonical as Canonical

28import qualified AST.Expression.Optimized as Optimized

29import qualified AST.Expression.Optimized as Optimized

29import qualified AST.Module.Name as Name

30import qualified AST.Module.Name as Name

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

50 HeaderDecl

51 HeaderDecl

51 { _tag :: SourceTag

52 { _tag :: SourceTag

52 , _name :: Name.Raw

53 , _name :: Name.Raw

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

54+ , _exports :: Exposing.Raw

54 , _settings :: SourceSettings

55 , _settings :: SourceSettings

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

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

56 }

57 }

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

62 zero = R.Position 1 1

63 zero = R.Position 1 1

63 noDocs = A.at zero zero Nothing

64 noDocs = A.at zero zero Nothing

64 in

65 in

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

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

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

85 { srcTag :: SourceTag

86 { srcTag :: SourceTag

86 , srcSettings :: SourceSettings

87 , srcSettings :: SourceSettings

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

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

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

89+ , srcExports :: Exposing.Raw

89 , srcImports :: [UserImport]

90 , srcImports :: [UserImport]

90 , srcDecls :: [Decl.Source]

91 , srcDecls :: [Decl.Source]

91 }

92 }

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

113data ValidInfo =

114data ValidInfo =

114 Valid

115 Valid

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

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

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

117+ , validExports :: Exposing.Raw

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

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

118 , validDecls :: Decl.Valid

119 , validDecls :: Decl.Valid

119 , validEffects :: Effects.Raw

120 , validEffects :: Effects.Raw

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

141data ImportMethod =

142data ImportMethod =

142 ImportMethod

143 ImportMethod

143 { alias :: Maybe Text

144 { alias :: Maybe Text

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

145+ , exposedVars :: !Exposing.Raw

145 }

146 }

146

147

148

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

152data Info program =

153data Info program =

153 Info

154 Info

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

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

155− , exports :: [Var.Value]

156+ , exports :: Exposing.Canonical

156 , imports :: [Name.Raw]

157 , imports :: [Name.Raw]

157 , program :: program

158 , program :: program

158 , types :: Types

159 , types :: Types

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

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

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

195data Interface =

196data Interface =

196 Interface

197 Interface

197− { iExports :: [Var.Value]

198+ { iExports :: Exposing.Canonical

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

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

199 , iTypes :: Types

200 , iTypes :: Types

200 , iUnions :: Unions

201 , iUnions :: Unions

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

226

227

227 else

228 else

228 Just $ Interface

229 Just $ Interface

229− { iExports = []

230+ { iExports = Exposing.nothing

230 , iImports = []

231 , iImports = []

231 , iTypes = Map.empty

232 , iTypes = Map.empty

232 , iUnions = myUnions

233 , iUnions = myUnions

src/AST/Variable.hs+67−170

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

1{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE FlexibleInstances #-}

2{-# LANGUAGE OverloadedStrings #-}

3{-# 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

5import Data.Binary

15import Data.Binary

6−import qualified Data.Maybe as Maybe

7import Data.Monoid ((<>))

16import Data.Monoid ((<>))

8import qualified Data.Set as Set

17import qualified Data.Set as Set

9−import qualified Data.Text as Text

10import Data.Text (Text)

18import Data.Text (Text)

12import qualified AST.Helpers as Help

20import qualified AST.Helpers as Help

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

20newtype Raw = Raw Text

28newtype Raw = Raw Text

21− deriving (Eq, Ord)

29+ deriving (Eq, Ord)

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

28data Home

36data Home

29− = BuiltIn

37+ = BuiltIn

30− | Module ModuleName.Canonical

38+ | Module !ModuleName.Canonical

31− | TopLevel ModuleName.Canonical

39+ | TopLevel !ModuleName.Canonical

32− | Local

40+ | Local

33− deriving (Eq, Ord)

41+ deriving (Eq, Ord)

36−data Canonical = Canonical

44+data Canonical =

45+ Canonical

37 { _home :: !Home

46 { _home :: !Home

38 , _name :: !Text

47 , _name :: !Text

39 }

48 }

40 deriving (Eq, Ord)

49 deriving (Eq, Ord)

52+

53+-- HELPERS

54+

55+

43local :: Text -> Canonical

56local :: Text -> Canonical

44local x =

57local x =

45 Canonical Local x

58 Canonical Local x

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

60 Canonical (Module home) name

73 Canonical (Module home) name

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−

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

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

74inCore home name =

77inCore home name =

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

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

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

110 True

113 True

111

114

112

115

116+isCons :: Canonical -> Bool

117+isCons var =

118+ case var of

119+ Canonical BuiltIn "::" ->

120+ True

121+

122+ _ ->

123+ False

124+

125+

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

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

114is home name var =

127is home name var =

115 var == inCore home name

128 var == inCore home name

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

195

208

196

209

197

210

198−-- VARIABLE TO STRING

211+-- VARIABLE TO TEXT

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

282

212

283

213

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

214+rawToText :: Raw -> Text

285−getAliases values =

215+rawToText (Raw name) =

286− Maybe.mapMaybe getAlias values

216+ name

287

217

288

218

289−getAlias :: Value -> Maybe Text

219+toText :: Canonical -> Text

290−getAlias value =

220+toText (Canonical home name) =

291− case value of

221+ case home of

292− Value _-> Nothing

222+ BuiltIn ->

293− Alias name -> Just name

223+ name

294− Union _ _ -> Nothing

295−

296

224

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

225+ Module moduleName ->

298−getUnions values =

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

299− Maybe.mapMaybe getUnion values

300

227

228+ TopLevel _ ->

229+ name

301

230

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

231+ Local ->

303−getUnion value =

232+ name

304− case value of

305− Value _ -> Nothing

306− Alias _ -> Nothing

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

308

233

309

234

310

235

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

312

237

313

238

314instance Binary Canonical where

239instance Binary Canonical where

315− put (Canonical home name) =

240+ put (Canonical home name) =

316− case home of

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

242+ BuiltIn ->

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

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

358

244

245+ Module path ->

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

359

247

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

248+ TopLevel path ->

361− put (Listing explicits open) =

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

362− put explicits >> put open

363

250

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

4import Prelude hiding (last)

5import qualified Data.Foldable as T

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

6import qualified Data.List as List

7import qualified Data.List as List

7import qualified Data.Map as Map

8import qualified Data.Map as Map

8import qualified Data.Maybe as Maybe

9import qualified Data.Maybe as Maybe

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

10import Data.Text (Text)

11import Data.Text (Text)

12import qualified AST.Declaration as D

13import qualified AST.Declaration as D

14+import qualified AST.Effects as Effects

15+import qualified AST.Exposing as Exposing

13import qualified AST.Expression.Source as Src

16import qualified AST.Expression.Source as Src

14import qualified AST.Expression.Canonical as C

17import qualified AST.Expression.Canonical as C

15import qualified AST.Module as Module

18import qualified AST.Module as Module

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

57 do env <- Setup.environment importDict interfaces modul

60 do env <- Setup.environment importDict interfaces modul

59 (,,,) env

62 (,,,) env

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

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

61 <*> canonicalizeDecls env decls

64 <*> canonicalizeDecls env decls

62 <*> Effects.canonicalize env effects

65 <*> Effects.canonicalize env effects

63 in

66 in

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

135-- EXPORTS

138-- EXPORTS

136

139

137

140

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

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

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

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

140− if open then

143+ case rawExposing of

144+ Exposing.Open ->

141− Result.ok fullList

145+ Result.ok internalApi

142−

146+

143− else

147+ Exposing.Explicit entries ->

144− let

148+ let

145− (allValues, allAliases, allAdts) =

149+ valueSet = Set.fromList values

146− maybeUnzip3 (map splitValue fullList)

150+ aliasSet = Set.fromList aliases

147−

151+ unionMap = Map.fromList unions

148− (values, aliases, adts) =

149− maybeUnzip3 (map splitLocatedValue partialList)

150−

151− adtTypes =

152− map fst allAdts

153− in

152+ in

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

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

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

154+ (exposing, []) ->

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

155+ do checkForDups entries

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

156+ Result.ok exposing

158− <*> allUnique partialList

157+

159−

158+ (_, errors) ->

160−

159+ Result.throwMany errors

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

160+

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

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

163− if Set.member name allValuesSet then

172+ if Set.member name vSet then

164− Result.ok (Var.Value name)

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

165− else

174+ , errors

166− manyNotFound region [name] allValues

175+ )

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

204

176

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

205

195

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

196+ else

207−manyNotFound region nameList possibilities =

197+ ( exposing

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

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

209

233

210

234

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

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

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

214 Help.nearbyNames id badName possibilities

238 Help.nearbyNames id badName possibilities

215

239

216

240

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

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

218−allUnique statedExports =

242+checkForDups entries =

219 let

243 let

220− valueToText value =

221− case value of

222− Var.Value name -> name

223− Var.Alias name -> name

224− Var.Union name _ -> name

225−

226 locations =

244 locations =

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

245+ A.listToDict Exposing.getName entries

228

246

229− isUnique value allRegions =

247+ isUnique name (region :| duplicates) =

230− case allRegions of

248+ case duplicates of

231− region : _ : _ ->

249+ [] ->

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

250+ Result.ok ()

233

251

234− _ ->

252+ _ ->

235− Result.ok ()

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

236 in

254 in

237 T.sequenceA_ (Map.mapWithKey isUnique locations)

255 T.sequenceA_ (Map.mapWithKey isUnique locations)

238

256

239

257

240

258

241−-- CONVERSIONS

259+-- ALL POSSIBLE EXPOSED VALUES

242

260

243

261

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

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

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

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

246 let

264 let

247− fromDef (A.A _ def) =

265+ values =

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

266+ Effects.toExposedValues effects

249−

267+ ++ concatMap getAliasValues aliases

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

268+ ++ concatMap getDefValues defs

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 ]

260 in

269 in

261− concat

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

262− [ map fromUnion unions

263− , concatMap fromAlias aliases

264− , concatMap fromDef defs

265− ]

266−

267−

268

271

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)

277

272

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

274+getDefValues (A.A _ def) =

275+ P.boundVarList (Src.getPattern def)

278

276

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)

286

277

287− Var.Alias name ->

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

288− (Nothing, Just name, Nothing)

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

280+ case tipe of

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

282+ [ name ]

289

283

290− Var.Union name listing ->

284+ _ ->

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

285+ []

292

286

293

287

294−splitLocatedValue

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

295− :: A.Located Var.Value

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

296− ->

290+ name

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)

305

291

306− Var.Alias name ->

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

308

292

309− Var.Union name listing ->

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

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

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

295+ (name, map fst ctors)

311

296

312

297

313

298

src/Canonicalize/Effects.hs+9−4

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

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

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

3+module Canonicalize.Effects

4+ ( canonicalize

5+ , toExposedValues

6+ , checkPortType

7+ )

8+ where

5import qualified Data.Foldable as F

10import qualified Data.Foldable as F

6import Data.Text (Text)

11import Data.Text (Text)

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

21-- TO EXPORT VALUES

26-- TO EXPORT VALUES

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

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

25−toValues effects =

30+toExposedValues effects =

26 case effects of

31 case effects of

27 Effects.None ->

32 Effects.None ->

28 []

33 []

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

31 []

36 []

33 Effects.Port ports ->

38 Effects.Port ports ->

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

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

src/Canonicalize/Setup.hs+79−97

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

13import qualified AST.Declaration as D

14import qualified AST.Effects as Effects

15+import qualified AST.Exposing as Exposing

15import qualified AST.Expression.Source as Src

16import qualified AST.Expression.Source as Src

16import qualified AST.Module as Module

17import qualified AST.Module as Module

17import qualified AST.Module.Name as ModuleName

18import qualified AST.Module.Name as ModuleName

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

68importToPatches

69importToPatches

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

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

70− -> Module.Interfaces

71+ -> Module.Interfaces

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

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

72− -> Result [Env.Patch]

73+ -> Result [Env.Patch]

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

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

74 let

75 let

75 maybeInterface =

76 maybeInterface =

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

95 (Module.ImportMethod maybeAlias listing) =

96 (Module.ImportMethod maybeAlias listing) =

96 method

97 method

98− (Var.Listing exposedValues open) =

99− listing

100−

101 qualifier =

99 qualifier =

102 maybe (ModuleName.toText rawImportName) id maybeAlias

100 maybe (ModuleName.toText rawImportName) id maybeAlias

103

101

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

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

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

109

107

110 unqualifiedPatches =

108 unqualifiedPatches =

111− if open then

109+ case listing of

110+ Exposing.Open ->

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

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

113

112

114− else

113+ Exposing.Explicit xs ->

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

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

116 in

115 in

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

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

118

117

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

154

153

155

154

156

155

157−-- PATCHES FOR INDIVIDUAL VALUES

156+-- PATCHES FOR INDIVIDUAL ENTRIES

158

157

159

158

160−valueToPatches

159+entryToPatches

161− :: R.Region

162− -> ModuleName.Canonical

160+ :: ModuleName.Canonical

163− -> Module.Interface

161+ -> Module.Interface

164− -> Var.Value

162+ -> A.Located Exposing.Entry

165− -> Result [Env.Patch]

163+ -> Result [Env.Patch]

166−valueToPatches region moduleName interface value =

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

167 let

165 let

168− patch mkPatch x =

166+ patch mkPatch name =

169− mkPatch x (Var.fromModule moduleName x)

167+ mkPatch name (Var.fromModule moduleName name)

170

168

171− patternPatch (x, numArgs) =

169+ patternPatch (name, numArgs) =

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

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

173

171

174− notFound getNames x =

172+ notFound subRegion getNames name =

175 Module.iExports interface

173 Module.iExports interface

176 |> getNames

174 |> getNames

177− |> Help.nearbyNames id x

175+ |> Help.nearbyNames id name

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

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

179− |> Result.throw region

177+ |> Result.throw subRegion

180 in

178 in

181− case value of

179+ case entry of

182− Var.Value x ->

180+ Exposing.Lower name ->

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

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

184− notFound Var.getValues x

182+ notFound region Exposing._values name

185

183

186 else

184 else

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

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

188

186

189− Var.Alias x ->

187+ Exposing.Upper x Nothing ->

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

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

191 Just (tvars, t) ->

189 Just (tvars, t) ->

192− let

190+ let

193− alias =

191+ alias =

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

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

195− in

193+ in

196− Result.ok $

194+ Result.ok $

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

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

198− [alias, patch Env.Value x]

196+ [alias, patch Env.Value x]

199

197

200− else

198+ else

201− [alias]

199+ [alias]

202

200

203 Nothing ->

201 Nothing ->

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

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

205− Just (_,_) ->

203+ Just (_,_) ->

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

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

207−

205+

208− Nothing ->

206+ Nothing ->

209− let getNames values =

207+ let getNames values =

210− Var.getAliases values

208+ Exposing._aliases values

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

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

212− in

210+ in

213− notFound getNames x

211+ notFound region getNames x

214−

212+

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

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

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

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

217 Nothing ->

215 Nothing ->

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

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

219

217

220 Just (_tvars, realCtors) ->

218 Just (_tvars, realCtors) ->

221− patches <$>

219+ patches <$>

222− if open then

220+ case exposing of

221+ Exposing.Open ->

223− Result.ok realCtorList

222+ Result.ok realCtorList

224

223

225− else

224+ Exposing.Explicit xs ->

226− traverse ctorExists givenCtorNames

225+ traverse ctorExists xs

227 where

226 where

228 realCtorList =

227 realCtorList =

229 map (second length) realCtors

228 map (second length) realCtors

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

231 realCtorDict =

230 realCtorDict =

232 Map.fromList realCtorList

231 Map.fromList realCtorList

233

232

234− ctorExists givenCtorName =

233+ ctorExists (A.A ctorRegion givenCtorName) =

235 case Map.lookup givenCtorName realCtorDict of

234 case Map.lookup givenCtorName realCtorDict of

236 Just numArgs ->

235 Just numArgs ->

237− Result.ok (givenCtorName, numArgs)

236+ Result.ok (givenCtorName, numArgs)

238

237

239 Nothing ->

238 Nothing ->

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

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

241

240

242 patches ctors =

241 patches ctors =

243 patch Env.Union givenName

242 patch Env.Union givenName

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

406

405

407restrictToPublicApi :: Module.Interface -> Module.Interface

406restrictToPublicApi :: Module.Interface -> Module.Interface

408restrictToPublicApi interface =

407restrictToPublicApi interface =

408+ let

409+ (Exposing.Canonical values aliases unions) =

410+ Module.iExports interface

411+ in

409 interface

412 interface

410− { Module.iTypes =

413+ { Module.iTypes = Map.fromList $

411− Map.fromList $

412− Maybe.mapMaybe

413− (get (Module.iTypes interface))

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

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

430

415

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

416+ , Module.iAliases = Map.fromList $

432− unions =

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

433− Var.getUnions exports

418+

419+ , Module.iUnions = Map.fromList $

420+ Maybe.mapMaybe (trimUnions interface) unions

421+ }

434

422

435− ctors :: [Text]

436− ctors =

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

438

423

439

424

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

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

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

447 Just (key, value)

432 Just (key, value)

448

433

449

434

450−trimUnions

451− :: Module.Interface

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

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

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

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

436+trimUnions interface (name, exposedCtors) =

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

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

456 Nothing ->

438 Nothing ->

457 Nothing

439 Nothing

458

440

459 Just (tvars, ctors) ->

441 Just (tvars, ctors) ->

460 let

442 let

461− isExported (ctor, _) =

443+ isExposed (ctor, _) =

462− ctor `elem` exportedCtors

444+ ctor `elem` exposedCtors

463 in

445 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+{-# OPTIONS_GHC -Wall #-}

1−module Docs.AST where

2+module Docs.AST

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

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

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

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

7+ )

8+ where

3import qualified Data.Map as Map

11import qualified Data.Map as Map

4import Data.Text (Text)

12import Data.Text (Text)

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

7import qualified Reporting.Annotation as A

15import qualified Reporting.Annotation as A

10−-- FULL DOCUMENTATION

12−data Docs t =

19+-- DOCS

13− Docs

20+

21+

22+data Centralized =

23+ Centralized

14 { comment :: Text

24 { 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)

18 }

49 }

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

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

53+

23−type Checked = Docs Type.Type

55+type GoodValue = Value Text Type.Type

26−-- VALUE DOCUMENTATION

59+-- ALIAS

60+

61+

28−data Alias = Alias

62+data Alias comment =

63+ Alias

29− { aliasComment :: Maybe Text

64+ { aliasComment :: comment

30 , aliasArgs :: [Text]

65 , aliasArgs :: [Text]

31 , aliasType :: Type.Type

66 , aliasType :: Type.Type

32 }

67 }

70+type RawAlias = Alias (Maybe Text)

71+

72+

73+type GoodAlias = Alias Text

74+

75+

76+

77+-- UNION

78+

79+

35−data Union = Union

80+data Union comment =

81+ Union

36− { unionComment :: Maybe Text

82+ { unionComment :: comment

37 , unionArgs :: [Text]

83 , unionArgs :: [Text]

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

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

39 }

85 }

42−data Value t = Value

88+type RawUnion = Union (Maybe Text)

43− { valueComment :: Maybe Text

89+

44− , valueType :: t

90+

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

91+type GoodUnion = Union Text

46− }

src/Docs/Centralize.hs+5−6

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

10import qualified AST.Pattern as Pattern

11import qualified AST.Type as Type

12import qualified Docs.AST as Docs

13−import qualified Elm.Compiler.Type as Type

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

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

15import qualified Reporting.Annotation as A

14import qualified Reporting.Annotation as A

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

25 infixDict =

24 infixDict =

26 Map.fromList (map infixToEntry infixes)

25 Map.fromList (map infixToEntry infixes)

27 in

26 in

28− Docs.Docs

27+ Docs.Centralized

29 comment

28 comment

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

30 (Map.fromList (map aliasToEntry aliases))

31 (Map.fromList (map unionToEntry unions))

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

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

39defToEntry

38defToEntry

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

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

41 -> A.Commented Canonical.Def

40 -> A.Commented Canonical.Def

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

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

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

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

44 case pattern of

43 case pattern of

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

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

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

56 Nothing

55 Nothing

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)

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

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

61 let

60 let

62 ctors' =

61 ctors' =

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

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

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

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)

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

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

70 ( name

69 ( name

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

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

src/Docs/Check.hs+112−98

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

1+{-# OPTIONS_GHC -Wall #-}

1−module Docs.Check (check) where

2+module Docs.Check

3+ ( check

4+ )

5+ where

3−import qualified Data.List as List

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

4import qualified Data.Map as Map

9import qualified Data.Map as Map

5import qualified Data.Set as Set

10import qualified Data.Set as Set

6import Data.Text (Text)

11import Data.Text (Text)

8−import qualified AST.Variable as Var

13+import qualified AST.Exposing as Exposing

9import qualified Docs.AST as Docs

14import qualified Docs.AST as Docs

10import qualified Elm.Compiler.Type as Type

15import qualified Elm.Compiler.Type as Type

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

12import qualified Reporting.Annotation as A

16import qualified Reporting.Annotation as A

13import qualified Reporting.Error as Error

17import qualified Reporting.Error as Error

14import qualified Reporting.Error.Docs as E

18import qualified Reporting.Error.Docs as E

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

27−-- CHECK DOCUMENTATION

31+-- CHECK

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

31check exports (A.A region maybeDocs) =

35check exports (A.A region maybeDocs) =

32 case maybeDocs of

36 case maybeDocs of

33 Nothing ->

37 Nothing ->

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

37 checkHelp region exports docs

41 checkHelp region exports docs

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

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

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

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 =

42 let

69 let

43− exportedUnions =

70+ addUnit name =

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

71+ ( name, () )

72+

73+ exposed =

74+ Map.fromList $ map addUnit $

75+ values ++ aliases ++ map fst unions

76+

77+ docDict =

78+ A.listToDict id docNames

45 in

79 in

46− do docNames <- parseNames region comment

80+ checkOnlyInExports region (Map.difference exposed docDict)

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

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

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

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 ()

90+ names ->

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

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

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

100

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

101+ else

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

73− case getComment value of

74− Nothing ->

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

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

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

104

77− Just _ ->

105+ _ ->

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

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

107

108

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

109

110+-- CHECK COMMENT

111

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

112

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)

121

100

122

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

106

123

124+-- CHECK VALUE

107

125

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+

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

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

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

136+checkValueType region name maybeType =

110− case Docs.valueType value of

137+ case maybeType of

111 Just tipe ->

138 Just tipe ->

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

139+ R.ok tipe

113

140

114 Nothing ->

141 Nothing ->

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

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

116

143

117

144

118

145

119−-- CHECK MODULE COMMENT

146+-- CHECK ALIAS

120

147

121

148

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

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

123−checkModuleComment docRegion exports locatedDocNames =

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

124− let

151+ Docs.Alias

125− exportNames =

152+ <$> checkComment region name comment

126− map valueName exports

153+ <*> pure args

154+ <*> pure tipe

127

155

128− exportDict =

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

130

156

131− docDict =

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

133

157

134− extraNameError (name, region) =

158+-- CHECK UNION

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

136

159

137− docErrors =

138− Map.difference docDict exportDict

139− |> Map.toList

140− |> traverse extraNameError

141

160

142− namesOnlyInExports =

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

143− Map.difference exportDict docDict

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

144− |> Map.toList

163+ Docs.Union

145− |> map fst

164+ <$> checkComment region name comment

165+ <*> pure args

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

146

167

147− exportErrors =

168+

148− if null namesOnlyInExports then

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

149− R.ok ()

170+checkUnionCtors unions name ctors =

150− else

171+ let

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

172+ publicCtors =

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

174+

175+ isPublic (ctor, _) =

176+ ctor `elem` publicCtors

152 in

177 in

153− (\_ _ -> ())

178+ R.ok $ filter isPublic ctors

154− <$> exportErrors

155− <*> docErrors

156

179

157

180

158

181

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

169 R.ok names

192 R.ok names

170

193

171

194

172−

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

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

174namesParser names =

196namesParser names =

175 do isDocs <- chompUntilDocs

197 do isDocs <- chompUntilDocs

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

204 op <- infixOp

226 op <- infixOp

205 rightParen

227 rightParen

206 return op

228 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

5import Data.Text (Text)

7+import qualified AST.Exposing as E

7import qualified AST.Module as Module

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

11-- DEFAULT IMPORTS

14-- DEFAULT IMPORTS

16+

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

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

14(==>) = (,)

18(==>) = (,)

17defaults :: [Module.DefaultImport]

21defaults :: [Module.DefaultImport]

18defaults =

22defaults =

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

29 ]

33 ]

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

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

33−exposing vars =

37+exposing entries =

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

38+ Module.ImportMethod Nothing (explicit entries)

37−closedType :: Text -> Var.Value

41+closedType :: Text -> E.Entry

38closedType name =

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

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

52+explicit entries =

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

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

43−named name vars =

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

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) =

215 Var x

216

217 Type.RType var ->

218− Type (Var.toText var)

218+ Type (Var.rawToText var)

219

220 Type.RApp t ts ->

221 App (fromRawType t) (map fromRawType ts)

src/Elm/Docs.hs+7−11

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

16import qualified Elm.Compiler.Type as Type

17import qualified Elm.Compiler.Version as Version

18import qualified Elm.Package as Pkg

19−import qualified Reporting.Annotation as A

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

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

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

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

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

73 let

72 let

74− unwrap cmnt =

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

75− maybe "" id cmnt

74+ Value name comment tipe fix

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

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

78− Alias name (unwrap cmnt) args tipe

77+ Alias name comment args tipe

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

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

81− Union name (unwrap cmnt) args cases

80+ Union name comment args cases

82−

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

84− Value name (unwrap cmnt) tipe fix

85 in

81 in

86 Documentation

82 Documentation

87 name

83 name

src/Nitpick/Pattern.hs+2−2

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

70toBuilder :: Bool -> Pattern -> Builder

71toBuilder needsParens pattern =

72 case pattern of

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

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

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

76 Ctor tag args ->

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

104isCons pattern =

105 case pattern of

106 Ctor tag [_,_] ->

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

107+ Var.isCons tag

108

109 _ ->

110 False

src/Parse/Module.hs+25−24

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

5import Data.Text (Text)

7+import qualified AST.Exposing as Exposing

7import qualified AST.Module as Module

8import qualified AST.Module as Module

8−import qualified AST.Variable as Var

9import Parse.Helpers

10import qualified Reporting.Annotation as A

11import qualified Reporting.Error.Syntax as E

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

45 settings <- effectSettings

46 hint E.Exposing $ keyword "exposing"

47 spaces

48− exports <- listing (addLocation listingValue)

48+ exports <- exposing exposingEntry

49 popContext ()

50 docs <- maybeDocComment

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

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

156 pos <- whitespace

157 oneOf

158 [ do checkFreshLine pos

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

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

160 popContext ()

161 chompImports (userImport:imports)

162 , do checkSpace pos

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

178 pos <- whitespace

179 oneOf

180 [ 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 [])

182 popContext ()

183 chompImports (userImport:imports)

184 , do checkSpace pos

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

190chompExposing start name maybeAlias imports =

191 do keyword "exposing"

192 spaces

193− exposed <- listing listingValue

193+ exposed <- exposing exposingEntry

194 end <- getPosition

195 freshLine

196 let userImport = method start end name maybeAlias exposed

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

198 chompImports (userImport:imports)

199

200

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

202method start end name maybeAlias exposed =

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

204

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

207-- LISTING

208

209

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

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

211−listing parser =

211+exposing parser =

212 hint E.Listing $

213 do leftParen

214 spaces

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

217 dot

218 spaces

219 rightParen

220− return (Var.Listing [] True)

220+ return Exposing.Open

221− , do value <- parser

221+ , do value <- addLocation parser

222 spaces

223− listingHelp parser [value]

223+ exposingHelp parser [value]

224 ]

225

226

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

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

228−listingHelp parser values =

228+exposingHelp parser values =

229 oneOf

230 [ do comma

231 spaces

232− value <- parser

232+ value <- addLocation parser

233 spaces

234− listingHelp parser (value:values)

234+ exposingHelp parser (value:values)

235 , do rightParen

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

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

237 ]

238

239

240−listingValue :: Parser Var.Value

240+exposingEntry :: Parser Exposing.Entry

241−listingValue =

241+exposingEntry =

242 oneOf

243− [ Var.Value <$> lowVar

243+ [ Exposing.Lower <$> lowVar

244 , do leftParen

245 op <- infixOp

246 rightParen

247− return (Var.Value op)

247+ return (Exposing.Lower op)

248 , do name <- capVar

249 spaces

250+ Exposing.Upper name <$>

250− oneOf

251+ oneOf

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

252+ [ Just <$> exposing capVar

252− , return (Var.Alias name)

253+ , return Nothing

253− ]

254+ ]

254 ]

255 ]

255

256

257

src/Reporting/Annotation.hs+39−13

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

1+{-# OPTIONS_GHC -Wall #-}

1−module Reporting.Annotation where

2+module Reporting.Annotation

2−

3+ ( Annotated(..)

4+ , Located

5+ , Commented

6+ , at, merge, sameAs

7+ , map, drop

8+ , listToDict

9+ )

10+ where

11+

12+

3−import Prelude hiding (map)

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 ((<>))

4import Data.Text (Text)

18import Data.Text (Text)

5import qualified Reporting.Region as R

19import qualified Reporting.Region as R

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

9-- ANNOTATION

23-- ANNOTATION

12−data Annotated annotation a

26+data Annotated annotation a =

13− = A annotation a

27+ A annotation a

16type Located a =

30type Located a =

17− Annotated R.Region a

31+ Annotated R.Region a

20type Commented a =

34type Commented a =

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

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

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

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

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

29at start end value =

43at start end value =

30− A (R.Region start end) value

44+ A (R.Region start end) value

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

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

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

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

35− A (R.merge region1 region2) value

49+ A (R.merge region1 region2) value

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

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

39sameAs (A annotation _) value =

53sameAs (A annotation _) value =

40− A annotation value

54+ A annotation value

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

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

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

48−map f (A annotation value) =

62+map f (A info value) =

49− A annotation (f value)

63+ A info (f value)

52drop :: Annotated info a -> a

66drop :: Annotated info a -> a

53drop (A _ value) =

67drop (A _ value) =

54− value

68+ value

69+

70+

71+

72+-- ANALYZE

73+

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

14 = NoDocs

15 | OnlyInDocs Text [Text]

16 | OnlyInExports [Text]

17+ | Duplicates Text

17 | NoComment Text

18 | NoComment Text

18 | NoType Text

19 | NoType Text

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

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

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

59 )

60 )

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+

61 NoComment name ->

71 NoComment name ->

62 Report.report

72 Report.report

63 "DOCUMENTATION ERROR"

73 "DOCUMENTATION ERROR"

64 Nothing

74 Nothing

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

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

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

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

67 )

77 )

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

70 Report.report

80 Report.report

71 "MISSING ANNOTATION"

81 "MISSING ANNOTATION"

72 Nothing

82 Nothing

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

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

74 ( text $

84 ( text $

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

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

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

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