git.iko.soy/elk
on ed48cd2 help sign in
elk/src/Docs/Check.hs
180 lines 5.1 kB history raw
1module Docs.Check (check) where
3import Control.Applicative ((<$>),(<*>))
4import qualified Data.List as List
5import qualified Data.Map as Map
6import qualified Data.Set as Set
7import qualified Data.Traversable as T
8import Text.Parsec ((<|>), choice, many, setPosition, string)
9import Text.Parsec.Pos (newPos)
11import qualified AST.Variable as Var
12import qualified Docs.AST as Docs
13import qualified Elm.Compiler.Type as Type
14import Elm.Utils ((|>))
15import Parse.Helpers
16 ( addLocation, anyUntil, commaSep1, iParse, parens, simpleNewline, symOp
17 , var, whitespace
18 )
19import qualified Reporting.Annotation as A
20import qualified Reporting.Error.Docs as Error
21import qualified Reporting.Error.Helpers as Error (nearbyNames)
22import qualified Reporting.Region as R
23import qualified Reporting.Result as R
26type Result w a = R.Result w Error.Error a
29-- CHECK DOCUMENTATION
31check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> Result w Docs.Checked
32check exports (A.A region maybeDocs) =
33 case maybeDocs of
34 Nothing ->
35 R.throw region Error.NoDocs
37 Just docs ->
38 checkHelp region exports docs
41checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> Result w Docs.Checked
42checkHelp region exports (Docs.Docs comment aliases types values) =
43 let
44 docNames =
45 commentedNames region comment
47 docSet =
48 Set.fromList (map A.drop docNames)
50 checkCategory checkValue dict =
51 dict
52 |> Map.filterWithKey (\key _ -> Set.member key docSet)
53 |> Map.mapWithKey checkValue
54 |> T.traverse id
56 exportedUnions =
57 map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)
58 in
59 (\() -> Docs.Docs comment)
60 <$> checkModuleComment region exports docNames
61 <*> checkCategory (checkComment Docs.aliasComment) aliases
62 <*> checkCategory (checkUnion exportedUnions) types
63 <*> checkCategory checkValue values
66checkComment :: (a -> Maybe String) -> String -> A.Located a -> Result w (A.Located a)
67checkComment getComment name (A.A region value) =
68 case getComment value of
69 Nothing ->
70 R.throw region (Error.NoComment name)
72 Just _ ->
73 R.ok (A.A region value)
76checkUnion :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
77checkUnion exportedUnions name value =
78 const
79 <$> filterUnionTags exportedUnions name value
80 <*> checkComment Docs.unionComment name value
83filterUnionTags :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
84filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
85 let
86 exportedTags =
87 maybe [] id (List.lookup name exportedUnions)
88 in
89 R.ok $ A.A region $ union
90 { Docs.unionCases =
91 filter (\(tag, _) -> elem tag exportedTags) ctors
92 }
96checkValue :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
97checkValue name value =
98 const
99 <$> hasType name value
100 <*> checkComment Docs.valueComment name value
103hasType :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
104hasType name (A.A region value) =
105 case Docs.valueType value of
106 Just tipe ->
107 R.ok (A.A region (value { Docs.valueType = tipe }))
109 Nothing ->
110 R.throw region (Error.NoType name)
113-- CHECK MODULE COMMENT
115checkModuleComment :: R.Region -> [Var.Value] -> [A.Located String] -> Result w ()
116checkModuleComment docRegion exports locatedDocNames =
117 let
118 exportNames =
119 map valueName exports
121 exportDict =
122 Map.fromList (map (\name -> (name, ())) exportNames)
124 docDict =
125 Map.fromList (map (\(A.A region name) -> (name, region)) locatedDocNames)
127 extraNameError (name, region) =
128 R.throw region (Error.OnlyInDocs name (Error.nearbyNames id name exportNames))
130 docErrors =
131 Map.difference docDict exportDict
132 |> Map.toList
133 |> T.traverse extraNameError
135 namesOnlyInExports =
136 Map.difference exportDict docDict
137 |> Map.toList
138 |> map fst
140 exportErrors =
141 if null namesOnlyInExports then
142 R.ok ()
143 else
144 R.throw docRegion (Error.OnlyInExports namesOnlyInExports)
145 in
146 (\_ _ -> ())
147 <$> exportErrors
148 <*> docErrors
151commentedNames :: R.Region -> String -> [A.Located String]
152commentedNames (R.Region start _) comment =
153 let
154 nameParser =
155 choice
156 [ do string "@docs"
157 whitespace
158 commaSep1 (addLocation (var <|> parens symOp))
159 , do anyUntil simpleNewline
160 return []
161 ]
163 docCommentParser =
164 do setPosition (newPos "docs" (R.line start) (R.column start + 3))
165 concat <$> many nameParser
166 in
167 case iParse docCommentParser comment of
168 Left _ ->
169 []
171 Right names ->
172 names
175valueName :: Var.Value -> String
176valueName value =
177 case value of
178 Var.Value name -> name
179 Var.Alias name -> name
180 Var.Union name _ -> name