git.iko.soy/elk
on 41df71f help sign in
elk/src/Docs/Check.hs
182 lines 5.1 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.Binop (infixOp)
15import Parse.Helpers
16 ( addLocation, anyUntil, commaSep1, parens, parse, simpleNewline
17 , var, whitespace
18 )
19import qualified Reporting.Annotation as A
20import qualified Reporting.Error.Docs as Error
21import qualified Reporting.Error.Helpers as Error (nearbyNames)
22import qualified Reporting.Region as R
23import qualified Reporting.Result as R
27type Result w a =
28 R.Result () w Error.Error a
31-- CHECK DOCUMENTATION
33check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> Result w Docs.Checked
34check exports (A.A region maybeDocs) =
35 case maybeDocs of
36 Nothing ->
37 R.throw region Error.NoDocs
39 Just docs ->
40 checkHelp region exports docs
43checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> Result w Docs.Checked
44checkHelp region exports (Docs.Docs comment aliases types values) =
45 let
46 docNames =
47 commentedNames region comment
49 docSet =
50 Set.fromList (map A.drop docNames)
52 checkCategory checkValue dict =
53 dict
54 |> Map.filterWithKey (\key _ -> Set.member key docSet)
55 |> Map.mapWithKey checkValue
56 |> T.traverse id
58 exportedUnions =
59 map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)
60 in
61 (\() -> Docs.Docs comment)
62 <$> checkModuleComment region exports docNames
63 <*> checkCategory (checkComment Docs.aliasComment) aliases
64 <*> checkCategory (checkUnion exportedUnions) types
65 <*> checkCategory checkValue values
68checkComment :: (a -> Maybe String) -> String -> A.Located a -> Result w (A.Located a)
69checkComment getComment name (A.A region value) =
70 case getComment value of
71 Nothing ->
72 R.throw region (Error.NoComment name)
74 Just _ ->
75 R.ok (A.A region value)
78checkUnion :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
79checkUnion exportedUnions name value =
80 const
81 <$> filterUnionTags exportedUnions name value
82 <*> checkComment Docs.unionComment name value
85filterUnionTags :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
86filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
87 let
88 exportedTags =
89 maybe [] id (List.lookup name exportedUnions)
90 in
91 R.ok $ A.A region $ union
92 { Docs.unionCases =
93 filter (\(tag, _) -> elem tag exportedTags) ctors
94 }
98checkValue :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
99checkValue name value =
100 const
101 <$> hasType name value
102 <*> checkComment Docs.valueComment name value
105hasType :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
106hasType name (A.A region value) =
107 case Docs.valueType value of
108 Just tipe ->
109 R.ok (A.A region (value { Docs.valueType = tipe }))
111 Nothing ->
112 R.throw region (Error.NoType name)
115-- CHECK MODULE COMMENT
117checkModuleComment :: R.Region -> [Var.Value] -> [A.Located String] -> Result w ()
118checkModuleComment docRegion exports locatedDocNames =
119 let
120 exportNames =
121 map valueName exports
123 exportDict =
124 Map.fromList (map (\name -> (name, ())) exportNames)
126 docDict =
127 Map.fromList (map (\(A.A region name) -> (name, region)) locatedDocNames)
129 extraNameError (name, region) =
130 R.throw region (Error.OnlyInDocs name (Error.nearbyNames id name exportNames))
132 docErrors =
133 Map.difference docDict exportDict
134 |> Map.toList
135 |> T.traverse extraNameError
137 namesOnlyInExports =
138 Map.difference exportDict docDict
139 |> Map.toList
140 |> map fst
142 exportErrors =
143 if null namesOnlyInExports then
144 R.ok ()
145 else
146 R.throw docRegion (Error.OnlyInExports namesOnlyInExports)
147 in
148 (\_ _ -> ())
149 <$> exportErrors
150 <*> docErrors
153commentedNames :: R.Region -> String -> [A.Located String]
154commentedNames (R.Region (R.Position line column) _) comment =
155 let
156 nameParser =
157 choice
158 [ do string "@docs"
159 whitespace
160 commaSep1 (addLocation (var <|> parens infixOp))
161 , do anyUntil simpleNewline
162 return []
163 ]
165 docCommentParser =
166 do setPosition (newPos "docs" line (column + 3))
167 concat <$> many nameParser
168 in
169 case parse docCommentParser comment of
170 Left _ ->
171 []
173 Right names ->
174 names
177valueName :: Var.Value -> String
178valueName value =
179 case value of
180 Var.Value name -> name
181 Var.Alias name -> name
182 Var.Union name _ -> name