git.iko.soy/elk
on 239af83 help sign in
elk/src/Docs/Check.hs
179 lines 4.9 kB history raw
1module Docs.Check (Result, check) where
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
8import qualified AST.Variable as Var
9import qualified Docs.AST as Docs
10--import qualified Elm.Compiler.Type as Type
11--import Elm.Utils ((|>))
12--import Parse.Helpers
13import qualified Reporting.Annotation as A
14import qualified Reporting.Error.Docs as Error
15--import qualified Reporting.Error.Helpers as Error (nearbyNames)
16--import qualified Reporting.Region as R
17import qualified Reporting.Result as R
21type Result w a =
22 R.Result () w Error.Error a
25-- CHECK DOCUMENTATION
27check :: [Var.Value] -> Maybe (A.Located Docs.Centralized) -> Result w Docs.Checked
28check exports maybeDocs =
29 R.ok (error "TODO check docs" exports maybeDocs)
30{-
31 case maybeDocs of
32 Nothing ->
33 R.throw region Error.NoDocs
35 Just docs ->
36 checkHelp region exports docs
39checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> Result w Docs.Checked
40checkHelp region exports (Docs.Docs comment aliases types values) =
41 let
42 docNames =
43 commentedNames region comment
45 docSet =
46 Set.fromList (map A.drop docNames)
48 checkCategory checkValue dict =
49 dict
50 |> Map.filterWithKey (\key _ -> Set.member key docSet)
51 |> Map.mapWithKey checkValue
52 |> T.traverse id
54 exportedUnions =
55 map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)
56 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
64checkComment :: (a -> Maybe String) -> String -> A.Located a -> Result w (A.Located a)
65checkComment getComment name (A.A region value) =
66 case getComment value of
67 Nothing ->
68 R.throw region (Error.NoComment name)
70 Just _ ->
71 R.ok (A.A region value)
74checkUnion :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
75checkUnion exportedUnions name value =
76 const
77 <$> filterUnionTags exportedUnions name value
78 <*> checkComment Docs.unionComment name value
81filterUnionTags :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
82filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
83 let
84 exportedTags =
85 maybe [] id (List.lookup name exportedUnions)
86 in
87 R.ok $ A.A region $ union
88 { Docs.unionCases =
89 filter (\(tag, _) -> elem tag exportedTags) ctors
90 }
94checkValue :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
95checkValue name value =
96 const
97 <$> hasType name value
98 <*> checkComment Docs.valueComment name value
101hasType :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
102hasType name (A.A region value) =
103 case Docs.valueType value of
104 Just tipe ->
105 R.ok (A.A region (value { Docs.valueType = tipe }))
107 Nothing ->
108 R.throw region (Error.NoType name)
111-- CHECK MODULE COMMENT
113checkModuleComment :: R.Region -> [Var.Value] -> [A.Located String] -> Result w ()
114checkModuleComment docRegion exports locatedDocNames =
115 let
116 exportNames =
117 map valueName exports
119 exportDict =
120 Map.fromList (map (\name -> (name, ())) exportNames)
122 docDict =
123 Map.fromList (map (\(A.A region name) -> (name, region)) locatedDocNames)
125 extraNameError (name, region) =
126 R.throw region (Error.OnlyInDocs name (Error.nearbyNames id name exportNames))
128 docErrors =
129 Map.difference docDict exportDict
130 |> Map.toList
131 |> T.traverse extraNameError
133 namesOnlyInExports =
134 Map.difference exportDict docDict
135 |> Map.toList
136 |> map fst
138 exportErrors =
139 if null namesOnlyInExports then
140 R.ok ()
141 else
142 R.throw docRegion (Error.OnlyInExports namesOnlyInExports)
143 in
144 (\_ _ -> ())
145 <$> exportErrors
146 <*> docErrors
149commentedNames :: R.Region -> String -> [A.Located String]
150commentedNames (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 []
159 ]
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 []
169 Right names ->
170 names
173valueName :: Var.Value -> String
174valueName value =
175 case value of
176 Var.Value name -> name
177 Var.Alias name -> name
178 Var.Union name _ -> name
179-}