git.iko.soy/elk
on ce01547 help sign in
elk/src/Docs/Check.hs
153 lines 4.3 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, string)
10import qualified AST.Variable as Var
11import qualified Docs.AST as Docs
12import qualified Elm.Compiler.Type as Type
13import Elm.Utils ((|>))
14import Parse.Helpers
15 ( anyUntil, commaSep1, iParse, parens, simpleNewline, symOp, var
16 , whitespace
17 )
18import qualified Reporting.Annotation as A
19import qualified Reporting.Error.Docs as Error
20import qualified Reporting.Region as R
21import qualified Reporting.Result as R
24type Result w a = R.Result w Error.Error a
27-- CHECK DOCUMENTATION
29check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> Result w Docs.Checked
30check exports (A.A region maybeDocs) =
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 Set.fromList (commentedNames comment)
45 checkCategory checkValue dict =
46 dict
47 |> Map.filterWithKey (\key _ -> Set.member key docNames)
48 |> Map.mapWithKey checkValue
49 |> T.traverse id
51 exportedUnions =
52 map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)
53 in
54 (\() -> Docs.Docs comment)
55 <$> checkModuleComment region exports docNames
56 <*> checkCategory (checkComment Docs.aliasComment) aliases
57 <*> checkCategory (checkUnion exportedUnions) types
58 <*> checkCategory checkValue values
61checkComment :: (a -> Maybe String) -> String -> A.Located a -> Result w (A.Located a)
62checkComment getComment name (A.A region value) =
63 case getComment value of
64 Nothing ->
65 R.throw region (Error.NoComment name)
67 Just _ ->
68 R.ok (A.A region value)
71checkUnion :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
72checkUnion exportedUnions name value =
73 const
74 <$> filterUnionTags exportedUnions name value
75 <*> checkComment Docs.unionComment name value
78filterUnionTags :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
79filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
80 case List.lookup name exportedUnions of
81 Nothing ->
82 R.throw region (Error.OnlyInExports name)
84 Just tags ->
85 R.ok $ A.A region $ union
86 { Docs.unionCases =
87 filter (\(tag, _) -> elem tag tags) ctors
88 }
92checkValue :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
93checkValue name value =
94 const
95 <$> hasType name value
96 <*> checkComment Docs.valueComment name value
99hasType :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
100hasType name (A.A region value) =
101 case Docs.valueType value of
102 Just tipe ->
103 R.ok (A.A region (value { Docs.valueType = tipe }))
105 Nothing ->
106 R.throw region (Error.NoType name)
109-- CHECK MODULE COMMENT
111checkModuleComment :: R.Region -> [Var.Value] -> Set.Set String -> Result w ()
112checkModuleComment region exports docNames =
113 let
114 exportNames =
115 Set.fromList (map valueName exports)
117 onlyInDocs =
118 Set.toList (Set.difference docNames exportNames)
120 onlyInExports =
121 Set.toList (Set.difference exportNames docNames)
122 in
123 (\_ _ -> ())
124 <$> T.traverse (R.throw region . Error.OnlyInDocs) onlyInDocs
125 <*> T.traverse (R.throw region . Error.OnlyInExports) onlyInExports
128commentedNames :: String -> [String]
129commentedNames comment =
130 let
131 nameParser =
132 choice
133 [ do string "@docs"
134 whitespace
135 commaSep1 (var <|> parens symOp)
136 , do anyUntil simpleNewline
137 return []
138 ]
139 in
140 case iParse (concat <$> many nameParser) comment of
141 Left _ ->
142 []
144 Right names ->
145 names
148valueName :: Var.Value -> String
149valueName value =
150 case value of
151 Var.Value name -> name
152 Var.Alias name -> name
153 Var.Union name _ -> name