@@ -5,15 +5,16 @@ import qualified Data.List as List
55import qualified Data.Map as Map
66import qualified Data.Set as Set
77import qualified Data.Traversable as T
8−import Text.Parsec ((<|>), choice, many, string)
8+import Text.Parsec ((<|>), choice, many, setPosition, string)
9+import Text.Parsec.Pos (newPos)
910
1011import qualified AST.Variable as Var
1112import qualified Docs.AST as Docs
1213import qualified Elm.Compiler.Type as Type
1314import Elm.Utils ((|>))
1415import Parse.Helpers
15− ( anyUntil, commaSep1, iParse, parens, simpleNewline, symOp, var
16− , whitespace
16+ ( addLocation, anyUntil, commaSep1, iParse, parens, simpleNewline, symOp
17+ , var, whitespace
1718 )
1819import qualified Reporting.Annotation as A
1920import qualified Reporting.Error.Docs as Error
@@ -40,11 +41,14 @@ checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> Result w Docs.Checke
4041checkHelp region exports (Docs.Docs comment aliases types values) =
4142 let
4243 docNames =
43− Set.fromList (commentedNames comment)
44+ commentedNames region comment
45+
46+ docSet =
47+ Set.fromList (map A.drop docNames)
4448
4549 checkCategory checkValue dict =
4650 dict
47− |> Map.filterWithKey (\key _ -> Set.member key docNames)
51+ |> Map.filterWithKey (\key _ -> Set.member key docSet)
4852 |> Map.mapWithKey checkValue
4953 |> T.traverse id
5054
@@ -77,15 +81,14 @@ checkUnion exportedUnions name value =
7781
7882filterUnionTags :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
7983filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
80− case List.lookup name exportedUnions of
81− Nothing ->
82− R.throw region (Error.OnlyInExports name)
83−
84− Just tags ->
85− R.ok $ A.A region $ union
86− { Docs.unionCases =
87− filter (\(tag, _) -> elem tag tags) ctors
88− }
84+ let
85+ exportedTags =
86+ maybe [] id (List.lookup name exportedUnions)
87+ in
88+ R.ok $ A.A region $ union
89+ { Docs.unionCases =
90+ filter (\(tag, _) -> elem tag exportedTags) ctors
91+ }
8992
9093
9194
@@ -108,36 +111,53 @@ hasType name (A.A region value) =
108111
109112-- CHECK MODULE COMMENT
110113
111−checkModuleComment :: R.Region -> [Var.Value] -> Set.Set String -> Result w ()
112−checkModuleComment region exports docNames =
114+checkModuleComment :: R.Region -> [Var.Value] -> [A.Located String] -> Result w ()
115+checkModuleComment docRegion exports locatedDocNames =
113116 let
114117 exportNames =
115− Set.fromList (map valueName exports)
116−
117− onlyInDocs =
118− Set.toList (Set.difference docNames exportNames)
118+ Map.fromList (map (\v -> (valueName v, ())) exports)
119119
120− onlyInExports =
121− Set.toList (Set.difference exportNames docNames)
120+ docNames =
121+ Map.fromList (map (\(A.A region name) -> (name, region)) locatedDocNames)
122+
123+ docErrors =
124+ Map.difference docNames exportNames
125+ |> Map.toList
126+ |> T.traverse (\(name, region) -> R.throw region (Error.OnlyInDocs name))
127+
128+ namesOnlyInExports =
129+ Map.difference exportNames docNames
130+ |> Map.toList
131+ |> map fst
132+
133+ exportErrors =
134+ if null namesOnlyInExports then
135+ R.ok ()
136+ else
137+ R.throw docRegion (Error.OnlyInExports namesOnlyInExports)
122138 in
123139 (\_ _ -> ())
124− <$> T.traverse (R.throw region . Error.OnlyInDocs) onlyInDocs
125− <*> T.traverse (R.throw region . Error.OnlyInExports) onlyInExports
140+ <$> docErrors
141+ <*> exportErrors
126142
127143
128−commentedNames :: String -> [String]
129−commentedNames comment =
144+commentedNames :: R.Region -> String -> [A.Located String]
145+commentedNames (R.Region start _) comment =
130146 let
131147 nameParser =
132148 choice
133149 [ do string "@docs"
134150 whitespace
135− commaSep1 (var <|> parens symOp)
151+ commaSep1 (addLocation (var <|> parens symOp))
136152 , do anyUntil simpleNewline
137153 return []
138154 ]
155+
156+ docCommentParser =
157+ do setPosition (newPos "docs" (R.line start) (R.column start + 3))
158+ concat <$> many nameParser
139159 in
140− case iParse (concat <$> many nameParser) comment of
160+ case iParse docCommentParser comment of
141161 Left _ ->
142162 []
143163