git.iko.soy/elk
on 7aafdec help sign in
elk/src/Docs/Check.hs
179 lines 5.0 kB history raw
1module Docs.Check (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
25type Result w a = R.Result w Error.Error a
28-- CHECK DOCUMENTATION
30check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> Result w Docs.Checked
31check exports (A.A region maybeDocs) =
32 case maybeDocs of
33 Nothing ->
34 R.throw region Error.NoDocs
36 Just docs ->
37 checkHelp region exports docs
40checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> Result w Docs.Checked
41checkHelp region exports (Docs.Docs comment aliases types values) =
42 let
43 docNames =
44 commentedNames region comment
46 docSet =
47 Set.fromList (map A.drop docNames)
49 checkCategory checkValue dict =
50 dict
51 |> Map.filterWithKey (\key _ -> Set.member key docSet)
52 |> Map.mapWithKey checkValue
53 |> T.traverse id
55 exportedUnions =
56 map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)
57 in
58 (\() -> Docs.Docs comment)
59 <$> checkModuleComment region exports docNames
60 <*> checkCategory (checkComment Docs.aliasComment) aliases
61 <*> checkCategory (checkUnion exportedUnions) types
62 <*> checkCategory checkValue values
65checkComment :: (a -> Maybe String) -> String -> A.Located a -> Result w (A.Located a)
66checkComment getComment name (A.A region value) =
67 case getComment value of
68 Nothing ->
69 R.throw region (Error.NoComment name)
71 Just _ ->
72 R.ok (A.A region value)
75checkUnion :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
76checkUnion exportedUnions name value =
77 const
78 <$> filterUnionTags exportedUnions name value
79 <*> checkComment Docs.unionComment name value
82filterUnionTags :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
83filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
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 }
95checkValue :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
96checkValue name value =
97 const
98 <$> hasType name value
99 <*> checkComment Docs.valueComment name value
102hasType :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
103hasType name (A.A region value) =
104 case Docs.valueType value of
105 Just tipe ->
106 R.ok (A.A region (value { Docs.valueType = tipe }))
108 Nothing ->
109 R.throw region (Error.NoType name)
112-- CHECK MODULE COMMENT
114checkModuleComment :: R.Region -> [Var.Value] -> [A.Located String] -> Result w ()
115checkModuleComment docRegion exports locatedDocNames =
116 let
117 exportNames =
118 map valueName exports
120 exportDict =
121 Map.fromList (map (\name -> (name, ())) exportNames)
123 docDict =
124 Map.fromList (map (\(A.A region name) -> (name, region)) locatedDocNames)
126 extraNameError (name, region) =
127 R.throw region (Error.OnlyInDocs name (Error.nearbyNames id name exportNames))
129 docErrors =
130 Map.difference docDict exportDict
131 |> Map.toList
132 |> T.traverse extraNameError
134 namesOnlyInExports =
135 Map.difference exportDict docDict
136 |> Map.toList
137 |> map fst
139 exportErrors =
140 if null namesOnlyInExports then
141 R.ok ()
142 else
143 R.throw docRegion (Error.OnlyInExports namesOnlyInExports)
144 in
145 (\_ _ -> ())
146 <$> exportErrors
147 <*> docErrors
150commentedNames :: R.Region -> String -> [A.Located String]
151commentedNames (R.Region start _) comment =
152 let
153 nameParser =
154 choice
155 [ do string "@docs"
156 whitespace
157 commaSep1 (addLocation (var <|> parens symOp))
158 , do anyUntil simpleNewline
159 return []
160 ]
162 docCommentParser =
163 do setPosition (newPos "docs" (R.line start) (R.column start + 3))
164 concat <$> many nameParser
165 in
166 case iParse docCommentParser comment of
167 Left _ ->
168 []
170 Right names ->
171 names
174valueName :: Var.Value -> String
175valueName value =
176 case value of
177 Var.Value name -> name
178 Var.Alias name -> name
179 Var.Union name _ -> name