git.iko.soy/elk
on master help sign in
For union type docs, filter out tags which are not exported
a5d8eecEvan Czaplicki
src/Docs/Check.hs+44−21
compare with master
unifiedsplit
@@ -1,6 +1,7 @@
1module Docs.Check (check) where
1module Docs.Check (check) where
2
2
3import Control.Applicative ((<$>),(<*>))
3import Control.Applicative ((<$>),(<*>))
4+import qualified Data.List as List
4import qualified Data.Map as Map
5import qualified Data.Map as Map
5import qualified Data.Set as Set
6import qualified Data.Set as Set
6import qualified Data.Traversable as T
7import qualified Data.Traversable as T
@@ -20,9 +21,12 @@ import qualified Reporting.Region as R
20import qualified Reporting.Result as R
21import qualified Reporting.Result as R
21
22
22
23
24+type Result w a = R.Result w Error.Error a
25+
26+
23-- CHECK DOCUMENTATION
27-- CHECK DOCUMENTATION
24
28
25−check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> R.Result w Error.Error Docs.Checked
29+check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> Result w Docs.Checked
26check exports (A.A region maybeDocs) =
30check exports (A.A region maybeDocs) =
27 case maybeDocs of
31 case maybeDocs of
28 Nothing ->
32 Nothing ->
@@ -32,7 +36,7 @@ check exports (A.A region maybeDocs) =
32 checkHelp region exports docs
36 checkHelp region exports docs
33
37
34
38
35−checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> R.Result w Error.Error Docs.Checked
39+checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> Result w Docs.Checked
36checkHelp region exports (Docs.Docs comment aliases types values) =
40checkHelp region exports (Docs.Docs comment aliases types values) =
37 let
41 let
38 docNames =
42 docNames =
@@ -44,24 +48,18 @@ checkHelp region exports (Docs.Docs comment aliases types values) =
44 |> Map.mapWithKey checkValue
48 |> Map.mapWithKey checkValue
45 |> T.traverse id
49 |> T.traverse id
46
50
47− checkValue name value =
51+ exportedUnions =
48− const
52+ map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)
49− <$> hasType name value
50− <*> hasComment Docs.valueComment name value
51 in
53 in
52 (\() -> Docs.Docs comment)
54 (\() -> Docs.Docs comment)
53− <$> checkComment region exports docNames
55+ <$> checkModuleComment region exports docNames
54− <*> checkCategory (hasComment Docs.aliasComment) aliases
56+ <*> checkCategory (checkComment Docs.aliasComment) aliases
55− <*> checkCategory (hasComment Docs.unionComment) types
57+ <*> checkCategory (checkUnion exportedUnions) types
56 <*> checkCategory checkValue values
58 <*> checkCategory checkValue values
57
59
58
60
59−hasComment
61+checkComment :: (a -> Maybe String) -> String -> A.Located a -> Result w (A.Located a)
60− :: (a -> Maybe String)
61− -> String
62− -> A.Located a
63− -> R.Result w Error.Error (A.Located a)
64−hasComment getComment name (A.A region value) =
62+checkComment getComment name (A.A region value) =
65 case getComment value of
63 case getComment value of
66 Nothing ->
64 Nothing ->
67 R.throw region (Error.NoComment name)
65 R.throw region (Error.NoComment name)
@@ -70,10 +68,35 @@ hasComment getComment name (A.A region value) =
70 R.ok (A.A region value)
68 R.ok (A.A region value)
71
69
72
70
73−hasType
71+checkUnion :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
74− :: String
72+checkUnion exportedUnions name value =
73+ const
74+ <$> filterUnionTags exportedUnions name value
75+ <*> checkComment Docs.unionComment name value
76+
77+
78+filterUnionTags :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
79+filterUnionTags 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)
83+
84+ Just tags ->
85+ R.ok $ A.A region $ union
86+ { Docs.unionCases =
87+ filter (\(tag, _) -> elem tag tags) ctors
88+ }
89+
90+
91+
75− -> A.Located (Docs.Value (Maybe Type.Type))
92+checkValue :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
93+checkValue name value =
94+ const
95+ <$> hasType name value
96+ <*> checkComment Docs.valueComment name value
97+
98+
76− -> R.Result w Error.Error (A.Located (Docs.Value Type.Type))
99+hasType :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
77hasType name (A.A region value) =
100hasType name (A.A region value) =
78 case Docs.valueType value of
101 case Docs.valueType value of
79 Just tipe ->
102 Just tipe ->
@@ -85,8 +108,8 @@ hasType name (A.A region value) =
85
108
86-- CHECK MODULE COMMENT
109-- CHECK MODULE COMMENT
87
110
88−checkComment :: R.Region -> [Var.Value] -> Set.Set String -> R.Result w Error.Error ()
111+checkModuleComment :: R.Region -> [Var.Value] -> Set.Set String -> Result w ()
89−checkComment region exports docNames =
112+checkModuleComment region exports docNames =
90 let
113 let
91 exportNames =
114 exportNames =
92 Set.fromList (map valueName exports)
115 Set.fromList (map valueName exports)