git.iko.soy/elk
on f232da4 help sign in
elk/src/Docs/Check.hs
228 lines 5.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Docs.Check
3 ( check
4 )
5 where
8import Data.List.NonEmpty (NonEmpty((:|)))
9import qualified Data.Map as Map
10import qualified Data.Set as Set
11import Data.Text (Text)
13import qualified AST.Exposing as Exposing
14import qualified Docs.AST as Docs
15import qualified Elm.Compiler.Type as Type
16import qualified Reporting.Annotation as A
17import qualified Reporting.Error as Error
18import qualified Reporting.Error.Docs as E
19import qualified Reporting.Helpers as Help (nearbyNames)
20import qualified Reporting.Region as R
21import qualified Reporting.Result as R
22import Parse.Helpers
23 ( Parser, addLocation, getPosition
24 , spaces, checkSpace, whitespace, SPos(..)
25 , capVar, lowVar, leftParen, rightParen, infixOp, runAt
26 , chompUntilDocs, comma, oneOf
27 )
31-- CHECK
34check :: Exposing.Canonical -> A.Located (Maybe Docs.Centralized) -> R.Result () w Error.Error Docs.Checked
35check exports (A.A region maybeDocs) =
36 case maybeDocs of
37 Nothing ->
38 R.throw region (Error.Docs E.NoDocs)
40 Just docs ->
41 checkHelp region exports docs
44checkHelp :: R.Region -> Exposing.Canonical -> Docs.Centralized -> R.Result () w Error.Error Docs.Checked
45checkHelp region exposing (Docs.Centralized comment values aliases unions) =
46 do docNames <- parseNames region comment
48 let docSet = Set.fromList (map A.drop docNames)
49 let restrict checker dict =
50 Map.traverseWithKey checker (Map.restrictKeys dict docSet)
52 R.mapError Error.Docs $
53 Docs.Checked comment
54 <$> restrict checkValue values
55 <*> restrict checkAlias aliases
56 <*> restrict (checkUnion exposing) unions
57 <* checkCommentNames region exposing docNames
61-- CHECK COMMENT NAMES
64type Result w a = R.Result () w E.Error a
67checkCommentNames :: R.Region -> Exposing.Canonical -> [A.Located Text] -> Result w ()
68checkCommentNames region (Exposing.Canonical values aliases unions) docNames =
69 let
70 addUnit name =
71 ( name, () )
73 exposed =
74 Map.fromList $ map addUnit $
75 values ++ aliases ++ map fst unions
77 docDict =
78 A.listToDict id docNames
79 in
80 checkOnlyInExports region (Map.difference exposed docDict)
81 <* Map.traverseMaybeWithKey (checkDocName exposed) docDict
84checkOnlyInExports :: R.Region -> Map.Map Text () -> Result w ()
85checkOnlyInExports region onlyInExports =
86 case Map.keys onlyInExports of
87 [] ->
88 R.ok ()
90 names ->
91 R.throw region (E.OnlyInExports names)
94checkDocName :: Map.Map Text () -> Text -> NonEmpty R.Region -> Result w (Maybe a)
95checkDocName exposed name (region :| duplicates) =
96 case duplicates of
97 [] ->
98 if Map.member name exposed then
99 R.ok Nothing
101 else
102 R.throw region $ E.OnlyInDocs name $
103 Help.nearbyNames id name (Map.keys exposed)
105 _ ->
106 R.throw region (E.Duplicates name)
110-- CHECK COMMENT
113checkComment :: R.Region -> Text -> Maybe Text -> Result w Text
114checkComment region name maybeComment =
115 case maybeComment of
116 Just comment ->
117 R.ok comment
119 Nothing ->
120 R.throw region (E.NoComment name)
124-- CHECK VALUE
127checkValue :: Text -> A.Located Docs.RawValue -> Result w Docs.GoodValue
128checkValue name (A.A region (Docs.Value comment tipe assocPrec)) =
129 Docs.Value
130 <$> checkComment region name comment
131 <*> checkValueType region name tipe
132 <*> pure assocPrec
135checkValueType :: R.Region -> Text -> Maybe Type.Type -> Result w Type.Type
136checkValueType region name maybeType =
137 case maybeType of
138 Just tipe ->
139 R.ok tipe
141 Nothing ->
142 R.throw region (E.NoType name)
146-- CHECK ALIAS
149checkAlias :: Text -> A.Located Docs.RawAlias -> Result w Docs.GoodAlias
150checkAlias name (A.A region (Docs.Alias comment args tipe)) =
151 Docs.Alias
152 <$> checkComment region name comment
153 <*> pure args
154 <*> pure tipe
158-- CHECK UNION
161checkUnion :: Exposing.Canonical -> Text -> A.Located Docs.RawUnion -> Result w Docs.GoodUnion
162checkUnion (Exposing.Canonical _ _ unions) name (A.A region (Docs.Union comment args ctors)) =
163 Docs.Union
164 <$> checkComment region name comment
165 <*> pure args
166 <*> checkUnionCtors (Map.fromList unions) name ctors
169checkUnionCtors :: Map.Map Text [Text] -> Text -> [(Text, [Type.Type])] -> Result w [(Text, [Type.Type])]
170checkUnionCtors unions name ctors =
171 let
172 publicCtors =
173 maybe [] id (Map.lookup name unions)
175 isPublic (ctor, _) =
176 ctor `elem` publicCtors
177 in
178 R.ok $ filter isPublic ctors
182-- PARSE DOC COMMENT
185parseNames :: R.Region -> Text -> R.Result () w Error.Error [A.Located Text]
186parseNames (R.Region (R.Position row col) _) comment =
187 case runAt row (col + 3) (namesParser []) comment of
188 Left (A.A region parseError) ->
189 R.throw region (Error.Syntax parseError)
191 Right names ->
192 R.ok names
195namesParser :: [A.Located Text] -> Parser [A.Located Text]
196namesParser names =
197 do isDocs <- chompUntilDocs
198 if isDocs then namesParserHelp names else return names
201namesParserHelp :: [A.Located Text] -> Parser [A.Located Text]
202namesParserHelp names =
203 do pos <- getPosition
204 (SPos spos) <- whitespace
205 if pos == spos
206 then namesParser names
207 else namesParser =<< chompNames names
210chompNames :: [A.Located Text] -> Parser [A.Located Text]
211chompNames names =
212 do name <- addLocation (oneOf [ lowVar, capVar, operator ])
213 spos <- whitespace
214 oneOf
215 [ do checkSpace spos
216 comma
217 spaces
218 chompNames (name:names)
219 , return (name:names)
220 ]
223operator :: Parser Text
224operator =
225 do leftParen
226 op <- infixOp
227 rightParen
228 return op