git.iko.soy/elk
on 8ff0aee help sign in
elk/src/Docs/Check.hs
214 lines 5.8 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 Data.Text (Text)
8import qualified AST.Variable as Var
9import qualified Docs.AST as Docs
10import qualified Elm.Compiler.Type as Type
11import Elm.Utils ((|>))
12import qualified Reporting.Annotation as A
13import qualified Reporting.Error as Error
14import qualified Reporting.Error.Docs as E
15import qualified Reporting.Helpers as Help (nearbyNames)
16import qualified Reporting.Region as R
17import qualified Reporting.Result as R
18import Parse.Helpers
19 ( Parser, addLocation, getPosition
20 , spaces, checkSpace, whitespace, SPos(..)
21 , capVar, lowVar, leftParen, rightParen, infixOp, runAt
22 , chompUntilDocs, comma, oneOf
23 )
27-- CHECK DOCUMENTATION
30check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> R.Result () w Error.Error Docs.Checked
31check exports (A.A region maybeDocs) =
32 case maybeDocs of
33 Nothing ->
34 R.throw region (Error.Docs E.NoDocs)
36 Just docs ->
37 checkHelp region exports docs
40checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> R.Result () w Error.Error Docs.Checked
41checkHelp region exports (Docs.Docs comment aliases types values) =
42 let
43 exportedUnions =
44 map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)
45 in
46 do docNames <- parseNames region comment
47 let docSet = Set.fromList (map A.drop docNames)
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
56type Result w a = R.Result () w E.Error a
59checkCategory
60 :: Set.Set Text
61 -> (Text -> a -> Result w b)
62 -> Map.Map Text a
63 -> Result w (Map.Map Text b)
64checkCategory docSet check dict =
65 dict
66 |> Map.filterWithKey (\key _ -> Set.member key docSet)
67 |> Map.mapWithKey check
68 |> traverse id
71checkComment :: (a -> Maybe Text) -> Text -> A.Located a -> Result w (A.Located a)
72checkComment getComment name (A.A region value) =
73 case getComment value of
74 Nothing ->
75 R.throw region (E.NoComment name)
77 Just _ ->
78 R.ok (A.A region value)
81checkUnion :: [(Text, [Text])] -> Text -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
82checkUnion exportedUnions name value =
83 const
84 <$> filterUnionTags exportedUnions name value
85 <*> checkComment Docs.unionComment name value
88filterUnionTags :: [(Text, [Text])] -> Text -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
89filterUnionTags 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 }
101checkValue :: Text -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
102checkValue name value =
103 const
104 <$> hasType name value
105 <*> checkComment Docs.valueComment name value
108hasType :: Text -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
109hasType name (A.A region value) =
110 case Docs.valueType value of
111 Just tipe ->
112 R.ok (A.A region (value { Docs.valueType = tipe }))
114 Nothing ->
115 R.throw region (E.NoType name)
119-- CHECK MODULE COMMENT
122checkModuleComment :: R.Region -> [Var.Value] -> [A.Located Text] -> Result w ()
123checkModuleComment docRegion exports locatedDocNames =
124 let
125 exportNames =
126 map valueName exports
128 exportDict =
129 Map.fromList (map (\name -> (name, ())) exportNames)
131 docDict =
132 Map.fromList (map (\(A.A region name) -> (name, region)) locatedDocNames)
134 extraNameError (name, region) =
135 R.throw region (E.OnlyInDocs name (Help.nearbyNames id name exportNames))
137 docErrors =
138 Map.difference docDict exportDict
139 |> Map.toList
140 |> traverse extraNameError
142 namesOnlyInExports =
143 Map.difference exportDict docDict
144 |> Map.toList
145 |> map fst
147 exportErrors =
148 if null namesOnlyInExports then
149 R.ok ()
150 else
151 R.throw docRegion (E.OnlyInExports namesOnlyInExports)
152 in
153 (\_ _ -> ())
154 <$> exportErrors
155 <*> docErrors
159-- PARSE DOC COMMENT
162parseNames :: R.Region -> Text -> R.Result () w Error.Error [A.Located Text]
163parseNames (R.Region (R.Position row col) _) comment =
164 case runAt row (col + 3) (namesParser []) comment of
165 Left (A.A region parseError) ->
166 R.throw region (Error.Syntax parseError)
168 Right names ->
169 R.ok names
173namesParser :: [A.Located Text] -> Parser [A.Located Text]
174namesParser names =
175 do isDocs <- chompUntilDocs
176 if isDocs then namesParserHelp names else return names
179namesParserHelp :: [A.Located Text] -> Parser [A.Located Text]
180namesParserHelp names =
181 do pos <- getPosition
182 (SPos spos) <- whitespace
183 if pos == spos
184 then namesParser names
185 else namesParser =<< chompNames names
188chompNames :: [A.Located Text] -> Parser [A.Located Text]
189chompNames names =
190 do name <- addLocation (oneOf [ lowVar, capVar, operator ])
191 spos <- whitespace
192 oneOf
193 [ do checkSpace spos
194 comma
195 spaces
196 chompNames (name:names)
197 , return (name:names)
198 ]
201operator :: Parser Text
202operator =
203 do leftParen
204 op <- infixOp
205 rightParen
206 return op
209valueName :: Var.Value -> Text
210valueName value =
211 case value of
212 Var.Value name -> name
213 Var.Alias name -> name
214 Var.Union name _ -> name