git.iko.soy/elk
on f5bf4e6 help sign in
elk/src/Docs/Check.hs
181 lines 5.0 kB history raw
1module Docs.Check (Result, check) where
3import qualified Data.List as List
4import qualified Data.Map as Map
5import qualified Data.Set as Set
6import qualified Data.Traversable as T
7import Text.Parsec ((<|>), choice, many, setPosition, string)
8import Text.Parsec.Pos (newPos)
10import qualified AST.Variable as Var
11import qualified Docs.AST as Docs
12import qualified Elm.Compiler.Type as Type
13import Elm.Utils ((|>))
14import Parse.Helpers
15 ( addLocation, anyUntil, commaSep1, iParse, parens, simpleNewline, symOp
16 , var, whitespace
17 )
18import qualified Reporting.Annotation as A
19import qualified Reporting.Error.Docs as Error
20import qualified Reporting.Error.Helpers as Error (nearbyNames)
21import qualified Reporting.Region as R
22import qualified Reporting.Result as R
26type Result w a =
27 R.Result () w Error.Error a
30-- CHECK DOCUMENTATION
32check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> Result w Docs.Checked
33check exports (A.A region maybeDocs) =
34 case maybeDocs of
35 Nothing ->
36 R.throw region Error.NoDocs
38 Just docs ->
39 checkHelp region exports docs
42checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> Result w Docs.Checked
43checkHelp region exports (Docs.Docs comment aliases types values) =
44 let
45 docNames =
46 commentedNames region comment
48 docSet =
49 Set.fromList (map A.drop docNames)
51 checkCategory checkValue dict =
52 dict
53 |> Map.filterWithKey (\key _ -> Set.member key docSet)
54 |> Map.mapWithKey checkValue
55 |> T.traverse id
57 exportedUnions =
58 map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)
59 in
60 (\() -> Docs.Docs comment)
61 <$> checkModuleComment region exports docNames
62 <*> checkCategory (checkComment Docs.aliasComment) aliases
63 <*> checkCategory (checkUnion exportedUnions) types
64 <*> checkCategory checkValue values
67checkComment :: (a -> Maybe String) -> String -> A.Located a -> Result w (A.Located a)
68checkComment getComment name (A.A region value) =
69 case getComment value of
70 Nothing ->
71 R.throw region (Error.NoComment name)
73 Just _ ->
74 R.ok (A.A region value)
77checkUnion :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
78checkUnion exportedUnions name value =
79 const
80 <$> filterUnionTags exportedUnions name value
81 <*> checkComment Docs.unionComment name value
84filterUnionTags :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
85filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
86 let
87 exportedTags =
88 maybe [] id (List.lookup name exportedUnions)
89 in
90 R.ok $ A.A region $ union
91 { Docs.unionCases =
92 filter (\(tag, _) -> elem tag exportedTags) ctors
93 }
97checkValue :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
98checkValue name value =
99 const
100 <$> hasType name value
101 <*> checkComment Docs.valueComment name value
104hasType :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
105hasType name (A.A region value) =
106 case Docs.valueType value of
107 Just tipe ->
108 R.ok (A.A region (value { Docs.valueType = tipe }))
110 Nothing ->
111 R.throw region (Error.NoType name)
114-- CHECK MODULE COMMENT
116checkModuleComment :: R.Region -> [Var.Value] -> [A.Located String] -> Result w ()
117checkModuleComment docRegion exports locatedDocNames =
118 let
119 exportNames =
120 map valueName exports
122 exportDict =
123 Map.fromList (map (\name -> (name, ())) exportNames)
125 docDict =
126 Map.fromList (map (\(A.A region name) -> (name, region)) locatedDocNames)
128 extraNameError (name, region) =
129 R.throw region (Error.OnlyInDocs name (Error.nearbyNames id name exportNames))
131 docErrors =
132 Map.difference docDict exportDict
133 |> Map.toList
134 |> T.traverse extraNameError
136 namesOnlyInExports =
137 Map.difference exportDict docDict
138 |> Map.toList
139 |> map fst
141 exportErrors =
142 if null namesOnlyInExports then
143 R.ok ()
144 else
145 R.throw docRegion (Error.OnlyInExports namesOnlyInExports)
146 in
147 (\_ _ -> ())
148 <$> exportErrors
149 <*> docErrors
152commentedNames :: R.Region -> String -> [A.Located String]
153commentedNames (R.Region start _) comment =
154 let
155 nameParser =
156 choice
157 [ do string "@docs"
158 whitespace
159 commaSep1 (addLocation (var <|> parens symOp))
160 , do anyUntil simpleNewline
161 return []
162 ]
164 docCommentParser =
165 do setPosition (newPos "docs" (R.line start) (R.column start + 3))
166 concat <$> many nameParser
167 in
168 case iParse docCommentParser comment of
169 Left _ ->
170 []
172 Right names ->
173 names
176valueName :: Var.Value -> String
177valueName value =
178 case value of
179 Var.Value name -> name
180 Var.Alias name -> name
181 Var.Union name _ -> name