git.iko.soy/elk
on a4e77b1 help sign in
elk/src/Docs/Check.hs
130 lines 3.4 kB history raw
1module Docs.Check (check) where
3import Control.Applicative ((<$>),(<*>))
4import qualified Data.Map as Map
5import qualified Data.Set as Set
6import qualified Data.Traversable as T
7import Text.Parsec ((<|>), choice, many, string)
9import qualified AST.Variable as Var
10import qualified Docs.AST as Docs
11import qualified Elm.Compiler.Type as Type
12import Elm.Utils ((|>))
13import Parse.Helpers
14 ( anyUntil, commaSep1, iParse, parens, simpleNewline, symOp, var
15 , whitespace
16 )
17import qualified Reporting.Annotation as A
18import qualified Reporting.Error.Docs as Error
19import qualified Reporting.Region as R
20import qualified Reporting.Result as R
23-- CHECK DOCUMENTATION
25check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> R.Result w Error.Error Docs.Checked
26check exports (A.A region maybeDocs) =
27 case maybeDocs of
28 Nothing ->
29 R.throw region Error.NoDocs
31 Just docs ->
32 checkHelp region exports docs
35checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> R.Result w Error.Error Docs.Checked
36checkHelp region exports (Docs.Docs comment aliases types values) =
37 let
38 docNames =
39 Set.fromList (commentedNames comment)
41 checkCategory checkValue dict =
42 dict
43 |> Map.filterWithKey (\key _ -> Set.member key docNames)
44 |> Map.mapWithKey checkValue
45 |> T.traverse id
47 checkValue name value =
48 const
49 <$> hasType name value
50 <*> hasComment Docs.valueComment name value
51 in
52 (\() -> Docs.Docs comment)
53 <$> checkComment region exports docNames
54 <*> checkCategory (hasComment Docs.aliasComment) aliases
55 <*> checkCategory (hasComment Docs.unionComment) types
56 <*> checkCategory checkValue values
59hasComment
60 :: (a -> Maybe String)
61 -> String
62 -> A.Located a
63 -> R.Result w Error.Error (A.Located a)
64hasComment getComment name (A.A region value) =
65 case getComment value of
66 Nothing ->
67 R.throw region (Error.NoComment name)
69 Just _ ->
70 R.ok (A.A region value)
73hasType
74 :: String
75 -> A.Located (Docs.Value (Maybe Type.Type))
76 -> R.Result w Error.Error (A.Located (Docs.Value Type.Type))
77hasType name (A.A region value) =
78 case Docs.valueType value of
79 Just tipe ->
80 R.ok (A.A region (value { Docs.valueType = tipe }))
82 Nothing ->
83 R.throw region (Error.NoType name)
86-- CHECK MODULE COMMENT
88checkComment :: R.Region -> [Var.Value] -> Set.Set String -> R.Result w Error.Error ()
89checkComment region exports docNames =
90 let
91 exportNames =
92 Set.fromList (map valueName exports)
94 onlyInDocs =
95 Set.toList (Set.difference docNames exportNames)
97 onlyInExports =
98 Set.toList (Set.difference exportNames docNames)
99 in
100 (\_ _ -> ())
101 <$> T.traverse (R.throw region . Error.OnlyInDocs) onlyInDocs
102 <*> T.traverse (R.throw region . Error.OnlyInExports) onlyInExports
105commentedNames :: String -> [String]
106commentedNames comment =
107 let
108 nameParser =
109 choice
110 [ do string "@docs"
111 whitespace
112 commaSep1 (var <|> parens symOp)
113 , do anyUntil simpleNewline
114 return []
115 ]
116 in
117 case iParse (concat <$> many nameParser) comment of
118 Left _ ->
119 []
121 Right names ->
122 names
125valueName :: Var.Value -> String
126valueName value =
127 case value of
128 Var.Value name -> name
129 Var.Alias name -> name
130 Var.Union name _ -> name