git.iko.soy/elk
on 5fcbf86 help sign in
elk/src/Docs/Check.hs
234 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.Docs overview unions aliases values) =
46 do docNames <- parseNames region overview
48 let docSet = Set.fromList (map A.drop docNames)
49 let restrict checker dict =
50 Map.traverseWithKey (checkEntry checker) (Map.restrictKeys dict docSet)
52 R.mapError Error.Docs $
53 Docs.Docs overview
54 <$> restrict (checkUnion exposing) unions
55 <*> restrict checkAlias aliases
56 <*> restrict checkValue values
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 ENTRY
127checkEntry :: (R.Region -> Text -> a -> Result w b) -> Text -> Docs.Raw a -> Result w (Docs.Good b)
128checkEntry checkDetails name (A.A region (Docs.Entry comment details)) =
129 Docs.Entry
130 <$> checkComment region name comment
131 <*> checkDetails region name details
135-- CHECK UNION
138checkUnion :: Exposing.Canonical -> R.Region -> Text -> Docs.Union -> Result w Docs.Union
139checkUnion (Exposing.Canonical _ _ unions) _region name (Docs.Union args ctors) =
140 let
141 publicCtors =
142 maybe [] id (lookup name unions)
144 isPublic (ctor, _) =
145 ctor `elem` publicCtors
146 in
147 pure $ Docs.Union args (filter isPublic ctors)
151-- CHECK ALIAS
154checkAlias :: R.Region -> Text -> Docs.Alias -> Result w Docs.Alias
155checkAlias _ _ alias =
156 pure alias
160-- CHECK VALUE
163checkValue :: R.Region -> Text -> Docs.RawValue -> Result w Docs.GoodValue
164checkValue region name value =
165 case value of
166 Docs.Value tipe ->
167 Docs.Value
168 <$> checkValueType region name tipe
170 Docs.Infix tipe assoc prec ->
171 Docs.Infix
172 <$> checkValueType region name tipe
173 <*> pure assoc
174 <*> pure prec
177checkValueType :: R.Region -> Text -> Maybe Type.Type -> Result w Type.Type
178checkValueType region name maybeType =
179 case maybeType of
180 Just tipe ->
181 R.ok tipe
183 Nothing ->
184 R.throw region (E.NoType name)
188-- PARSE DOC COMMENT
191parseNames :: R.Region -> Text -> R.Result () w Error.Error [A.Located Text]
192parseNames (R.Region (R.Position row col) _) comment =
193 case runAt row (col + 3) (namesParser []) comment of
194 Left (A.A region parseError) ->
195 R.throw region (Error.Syntax parseError)
197 Right names ->
198 R.ok names
201namesParser :: [A.Located Text] -> Parser [A.Located Text]
202namesParser names =
203 do isDocs <- chompUntilDocs
204 if isDocs then namesParserHelp names else return names
207namesParserHelp :: [A.Located Text] -> Parser [A.Located Text]
208namesParserHelp names =
209 do pos <- getPosition
210 (SPos spos) <- whitespace
211 if pos == spos
212 then namesParser names
213 else namesParser =<< chompNames names
216chompNames :: [A.Located Text] -> Parser [A.Located Text]
217chompNames names =
218 do name <- addLocation (oneOf [ lowVar, capVar, operator ])
219 spos <- whitespace
220 oneOf
221 [ do checkSpace spos
222 comma
223 spaces
224 chompNames (name:names)
225 , return (name:names)
226 ]
229operator :: Parser Text
230operator =
231 do leftParen
232 op <- infixOp
233 rightParen
234 return op