@@ -1,84 +1,91 @@
1−module Docs.Check (Result, check) where
1+module Docs.Check (check) where
22
3−--import qualified Data.List as List
4−--import qualified Data.Map as Map
5−--import qualified Data.Set as Set
6−--import qualified Data.Traversable as T
3+import qualified Data.List as List
4+import qualified Data.Map as Map
5+import qualified Data.Set as Set
6+import Data.Text (Text)
77
88import qualified AST.Variable as Var
99import qualified Docs.AST as Docs
10−--import qualified Elm.Compiler.Type as Type
11−--import Elm.Utils ((|>))
12−--import Parse.Helpers
10+import qualified Elm.Compiler.Type as Type
11+import Elm.Utils ((|>))
1312import qualified Reporting.Annotation as A
14−import qualified Reporting.Error.Docs as Error
15−--import qualified Reporting.Error.Helpers as Error (nearbyNames)
16−--import qualified Reporting.Region as R
13+import qualified Reporting.Error as Error
14+import qualified Reporting.Error.Docs as E
15+import qualified Reporting.Helpers as Help (nearbyNames)
16+import qualified Reporting.Region as R
1717import qualified Reporting.Result as R
18+import Parse.Helpers
19+ ( Parser, addLocation, getPosition
20+ , spaces, checkSpace, whitespace, SPos(..)
21+ , capVar, lowVar, leftParen, rightParen, infixOp, runAt
22+ , chompUntilDocs, comma, oneOf
23+ )
1824
1925
2026
21−type Result w a =
22− R.Result () w Error.Error a
23−
24−
2527-- CHECK DOCUMENTATION
2628
27−check :: [Var.Value] -> Maybe (A.Located Docs.Centralized) -> Result w Docs.Checked
28−check exports maybeDocs =
29− R.ok (error "TODO check docs" exports maybeDocs)
30−{-
29+
30+check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> R.Result () w Error.Error Docs.Checked
31+check exports (A.A region maybeDocs) =
3132 case maybeDocs of
3233 Nothing ->
33− R.throw region Error.NoDocs
34+ R.throw region (Error.Docs E.NoDocs)
3435
3536 Just docs ->
36− checkHelp region exports docs
37+ checkHelp region exports docs
3738
3839
39−checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> Result w Docs.Checked
40+checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> R.Result () w Error.Error Docs.Checked
4041checkHelp region exports (Docs.Docs comment aliases types values) =
4142 let
42− docNames =
43− commentedNames region comment
44−
45− docSet =
46− Set.fromList (map A.drop docNames)
47−
48− checkCategory checkValue dict =
49− dict
50− |> Map.filterWithKey (\key _ -> Set.member key docSet)
51− |> Map.mapWithKey checkValue
52− |> T.traverse id
53−
5443 exportedUnions =
5544 map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)
5645 in
57− (\() -> Docs.Docs comment)
58− <$> checkModuleComment region exports docNames
59− <*> checkCategory (checkComment Docs.aliasComment) aliases
60− <*> checkCategory (checkUnion exportedUnions) types
61− <*> checkCategory checkValue values
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
54+
6255
56+type Result w a = R.Result () w E.Error a
6357
64−checkComment :: (a -> Maybe String) -> String -> A.Located a -> Result w (A.Located a)
58+
59+checkCategory
60+ :: Set.Set Text
61+ -> (Text -> a -> Result w b)
62+ -> Map.Map Text a
63+ -> Result w (Map.Map Text b)
64+checkCategory docSet check dict =
65+ dict
66+ |> Map.filterWithKey (\key _ -> Set.member key docSet)
67+ |> Map.mapWithKey check
68+ |> traverse id
69+
70+
71+checkComment :: (a -> Maybe Text) -> Text -> A.Located a -> Result w (A.Located a)
6572checkComment getComment name (A.A region value) =
6673 case getComment value of
6774 Nothing ->
68− R.throw region (Error.NoComment name)
75+ R.throw region (E.NoComment name)
6976
7077 Just _ ->
7178 R.ok (A.A region value)
7279
7380
74−checkUnion :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
81+checkUnion :: [(Text, [Text])] -> Text -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
7582checkUnion exportedUnions name value =
7683 const
7784 <$> filterUnionTags exportedUnions name value
7885 <*> checkComment Docs.unionComment name value
7986
8087
81−filterUnionTags :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
88+filterUnionTags :: [(Text, [Text])] -> Text -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
8289filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
8390 let
8491 exportedTags =
@@ -91,26 +98,28 @@ filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
9198
9299
93100
94−checkValue :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
101+checkValue :: Text -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
95102checkValue name value =
96103 const
97104 <$> hasType name value
98105 <*> checkComment Docs.valueComment name value
99106
100107
101−hasType :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
108+hasType :: Text -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
102109hasType name (A.A region value) =
103110 case Docs.valueType value of
104111 Just tipe ->
105112 R.ok (A.A region (value { Docs.valueType = tipe }))
106113
107114 Nothing ->
108− R.throw region (Error.NoType name)
115+ R.throw region (E.NoType name)
116+
109117
110118
111119-- CHECK MODULE COMMENT
112120
113−checkModuleComment :: R.Region -> [Var.Value] -> [A.Located String] -> Result w ()
121+
122+checkModuleComment :: R.Region -> [Var.Value] -> [A.Located Text] -> Result w ()
114123checkModuleComment docRegion exports locatedDocNames =
115124 let
116125 exportNames =
@@ -123,12 +132,12 @@ checkModuleComment docRegion exports locatedDocNames =
123132 Map.fromList (map (\(A.A region name) -> (name, region)) locatedDocNames)
124133
125134 extraNameError (name, region) =
126− R.throw region (Error.OnlyInDocs name (Error.nearbyNames id name exportNames))
135+ R.throw region (E.OnlyInDocs name (Help.nearbyNames id name exportNames))
127136
128137 docErrors =
129138 Map.difference docDict exportDict
130139 |> Map.toList
131− |> T.traverse extraNameError
140+ |> traverse extraNameError
132141
133142 namesOnlyInExports =
134143 Map.difference exportDict docDict
@@ -139,41 +148,67 @@ checkModuleComment docRegion exports locatedDocNames =
139148 if null namesOnlyInExports then
140149 R.ok ()
141150 else
142− R.throw docRegion (Error.OnlyInExports namesOnlyInExports)
151+ R.throw docRegion (E.OnlyInExports namesOnlyInExports)
143152 in
144153 (\_ _ -> ())
145154 <$> exportErrors
146155 <*> docErrors
147156
148157
149−commentedNames :: R.Region -> String -> [A.Located String]
150−commentedNames (R.Region (R.Position line column) _) comment =
151− let
152− nameParser =
153− choice
154− [ do string "@docs"
155− whitespace
156− commaSep1 (addLocation (var <|> parens infixOp))
157− , do anyUntil simpleNewline
158− return []
158+
159+-- PARSE DOC COMMENT
160+
161+
162+parseNames :: R.Region -> Text -> R.Result () w Error.Error [A.Located Text]
163+parseNames (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)
167+
168+ Right names ->
169+ R.ok names
170+
171+
172+
173+namesParser :: [A.Located Text] -> Parser [A.Located Text]
174+namesParser names =
175+ do isDocs <- chompUntilDocs
176+ if isDocs then namesParserHelp names else return names
177+
178+
179+namesParserHelp :: [A.Located Text] -> Parser [A.Located Text]
180+namesParserHelp names =
181+ do pos <- getPosition
182+ (SPos spos) <- whitespace
183+ if pos == spos
184+ then namesParser names
185+ else namesParser =<< chompNames names
186+
187+
188+chompNames :: [A.Located Text] -> Parser [A.Located Text]
189+chompNames 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 names
159198 ]
160199
161− docCommentParser =
162− do setPosition (newPos "docs" line (column + 3))
163− concat <$> many nameParser
164− in
165− case parse docCommentParser comment of
166− Left _ ->
167− []
168200
169− Right names ->
170− names
201+operator :: Parser Text
202+operator =
203+ do leftParen
204+ op <- infixOp
205+ rightParen
206+ return op
171207
172208
173−valueName :: Var.Value -> String
209+valueName :: Var.Value -> Text
174210valueName value =
175211 case value of
176212 Var.Value name -> name
177213 Var.Alias name -> name
178214 Var.Union name _ -> name
179−-}