on master help sign in
Revive Elm.Docs and make it less clever
f41abdaEvan Czaplicki
src/AST/Utils/Binop.hs+1−1
@@ -1,6 +1,6 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module AST.Utils.Binop
2module AST.Utils.Binop
3− ( Precedence
3+ ( Precedence(..)
4 , Associativity(..)
4 , Associativity(..)
5 )
5 )
6 where
6 where
src/Elm/Docs.hs+130−86
@@ -6,14 +6,12 @@ module Elm.Docs
6 , toDict
6 , toDict
7 , decoder
7 , decoder
8 , encode
8 , encode
9− , Docs.Docs(..)
10− , Docs.Checked
11− , Docs.Entry(..)
12− , Docs.Union(..)
9+ , Union(..)
13− , Docs.Alias(..)
10+ , Alias(..)
14− , Docs.Value(..)
11+ , Value(..)
15− , Decl.Assoc(..)
12+ , Binop(..)
16− , Decl.assocToText
13+ , Binop.Associativity(..)
14+ , Binop.Precedence(..)
17 )
15 )
18 where
16 where
19
17
@@ -21,10 +19,10 @@ module Elm.Docs
21import qualified Data.Map as Map
19import qualified Data.Map as Map
22import Data.Text (Text)
20import Data.Text (Text)
23
21
24−import qualified AST.Declaration as Decl
22+import qualified AST.Utils.Binop as Binop
25−import qualified Docs.AST as Docs
26import qualified Elm.Compiler.Module as Module
23import qualified Elm.Compiler.Module as Module
27import qualified Elm.Compiler.Type as Type
24import qualified Elm.Compiler.Type as Type
25+import qualified Elm.Name as N
28import qualified Json.Decode as Decode
26import qualified Json.Decode as Decode
29import qualified Json.Encode as Encode
27import qualified Json.Encode as Encode
30import Json.Encode ((==>))
28import Json.Encode ((==>))
@@ -35,19 +33,39 @@ import Json.Encode ((==>))
35
33
36
34
37type Documentation =
35type Documentation =
38− Map.Map Module.Raw Docs.Checked
36+ Map.Map N.Name Module
37+
38+
39+toDict :: [Module] -> Documentation
40+toDict modules =
41+ Map.fromList (map toPair modules)
42+
43+
44+
45+toPair :: Module -> (N.Name, Module)
46+toPair modul@(Module name _ _ _ _ _) =
47+ (name, modul)
48+
49+
50+
51+-- MODULES
39
52
40
53
41data Module =
54data Module =
42 Module
55 Module
43− { _name :: !Module.Raw
56+ { _name :: N.Name
44− , _docs :: !Docs.Checked
57+ , _comment :: Text
58+ , _unions :: Map.Map N.Name Union
59+ , _aliases :: Map.Map N.Name Alias
60+ , _values :: Map.Map N.Name Value
61+ , _binops :: Map.Map N.Name Binop
45 }
62 }
46
63
47
64
48−toDict :: [Module] -> Documentation
65+data Alias = Alias Text [N.Name] Type.Type
49−toDict modules =
66+data Union = Union Text [N.Name] [(N.Name, [Type.Type])]
50− Map.fromList $ map (\(Module name docs) -> (name, docs)) modules
67+data Value = Value Text Type.Type
68+data Binop = Binop Text Type.Type Binop.Associativity Binop.Precedence
51
69
52
70
53
71
@@ -55,13 +73,14 @@ toDict modules =
55
73
56
74
57encode :: Module -> Encode.Value
75encode :: Module -> Encode.Value
58−encode (Module name (Docs.Docs overview unions aliases values)) =
76+encode (Module name comment unions aliases values binops) =
59 Encode.object $
77 Encode.object $
60 [ "name" ==> Module.encode name
78 [ "name" ==> Module.encode name
61− , "comment" ==> Encode.text overview
79+ , "comment" ==> Encode.text comment
62− , "types" ==> Encode.list encodeUnion (Map.toList unions)
80+ , "unions" ==> Encode.list encodeUnion (Map.toList unions)
63 , "aliases" ==> Encode.list encodeAlias (Map.toList aliases)
81 , "aliases" ==> Encode.list encodeAlias (Map.toList aliases)
64 , "values" ==> Encode.list encodeValue (Map.toList values)
82 , "values" ==> Encode.list encodeValue (Map.toList values)
83+ , "binops" ==> Encode.list encodeBinop (Map.toList binops)
65 ]
84 ]
66
85
67
86
@@ -73,36 +92,31 @@ decoder :: Decode.Decoder Module
73decoder =
92decoder =
74 Module
93 Module
75 <$> Decode.field "name" Module.decoder
94 <$> Decode.field "name" Module.decoder
76− <*> decodeDocs
95+ <*> Decode.field "comment" Decode.text
96+ <*> Decode.field "unions" (dictDecoder union)
97+ <*> Decode.field "aliases" (dictDecoder alias)
98+ <*> Decode.field "values" (dictDecoder value)
99+ <*> Decode.field "binops" (dictDecoder binop)
77
100
78
101
79−decodeDocs :: Decode.Decoder Docs.Checked
102+dictDecoder :: Decode.Decoder a -> Decode.Decoder (Map.Map N.Name a)
80−decodeDocs =
103+dictDecoder entryDecoder =
81− Docs.Docs
104+ Map.fromList <$> Decode.list (named entryDecoder)
82− <$> Decode.field "comment" Decode.text
83− <*> Decode.field "types" (entryDictDecoder unionDecoder)
84− <*> Decode.field "aliases" (entryDictDecoder aliasDecoder)
85− <*> Decode.field "values" (entryDictDecoder valueDecoder)
86−
87
105
88−entryDictDecoder :: Decode.Decoder a -> Decode.Decoder (Map.Map Text (Docs.Good a))
89−entryDictDecoder subDecoder =
90− Map.fromList <$> Decode.list (entryDecoder subDecoder)
91
106
92−
93−entryDecoder :: Decode.Decoder a -> Decode.Decoder ( Text, Docs.Good a )
107+named :: Decode.Decoder a -> Decode.Decoder (N.Name, a)
94−entryDecoder subDecoder =
108+named entryDecoder =
109+ (,)
95− Decode.map2 (,) (Decode.field "name" Decode.text) $
110+ <$> Decode.field "name" Decode.text
96− Decode.map2 Docs.Entry (Decode.field "comment" Decode.text) $
111+ <*> entryDecoder
97− subDecoder
98
112
99
113
100
114
101−-- ENCODE UNION
115+-- UNION
102
116
103
117
104−encodeUnion :: ( Text, Docs.Good Docs.Union ) -> Encode.Value
118+encodeUnion :: (N.Name, Union) -> Encode.Value
105−encodeUnion ( name, Docs.Entry comment (Docs.Union args cases) ) =
119+encodeUnion (name, Union comment args cases) =
106 Encode.object
120 Encode.object
107 [ "name" ==> Encode.text name
121 [ "name" ==> Encode.text name
108 , "comment" ==> Encode.text comment
122 , "comment" ==> Encode.text comment
@@ -111,23 +125,24 @@ encodeUnion ( name, Docs.Entry comment (Docs.Union args cases) ) =
111 ]
125 ]
112
126
113
127
114−encodeCase :: ( Text, [Type.Type] ) -> Encode.Value
128+union :: Decode.Decoder Union
115−encodeCase ( tag, args ) =
129+union =
116− Encode.list id [ Encode.text tag, Encode.list Type.encode args ]
130+ Union
131+ <$> Decode.field "comment" Decode.text
132+ <*> Decode.field "args" (Decode.list Decode.text)
133+ <*> Decode.field "cases" (Decode.list caseDecoder)
117
134
118
135
119
136
120−-- DECODE UNION
137+-- UNION CASE
121
138
122
139
123−unionDecoder :: Decode.Decoder Docs.Union
140+encodeCase :: ( N.Name, [Type.Type] ) -> Encode.Value
124−unionDecoder =
141+encodeCase ( tag, args ) =
125− Docs.Union
142+ Encode.list id [ Encode.text tag, Encode.list Type.encode args ]
126− <$> Decode.field "args" (Decode.list Decode.text)
127− <*> Decode.field "cases" (Decode.list caseDecoder)
128
143
129
144
130−caseDecoder :: Decode.Decoder ( Text, [Type.Type] )
145+caseDecoder :: Decode.Decoder ( N.Name, [Type.Type] )
131caseDecoder =
146caseDecoder =
132 (,)
147 (,)
133 <$> Decode.index 0 Decode.text
148 <$> Decode.index 0 Decode.text
@@ -135,11 +150,11 @@ caseDecoder =
135
150
136
151
137
152
138−-- ENCODE ALIAS
153+-- ALIAS
139
154
140
155
141−encodeAlias :: ( Text, Docs.Good Docs.Alias ) -> Encode.Value
156+encodeAlias :: (N.Name, Alias) -> Encode.Value
142−encodeAlias ( name, Docs.Entry comment (Docs.Alias args tipe) ) =
157+encodeAlias ( name, Alias comment args tipe) =
143 Encode.object
158 Encode.object
144 [ "name" ==> Encode.text name
159 [ "name" ==> Encode.text name
145 , "comment" ==> Encode.text comment
160 , "comment" ==> Encode.text comment
@@ -148,60 +163,89 @@ encodeAlias ( name, Docs.Entry comment (Docs.Alias args tipe) ) =
148 ]
163 ]
149
164
150
165
166+alias :: Decode.Decoder Alias
167+alias =
168+ Alias
169+ <$> Decode.field "comment" Decode.text
170+ <*> Decode.field "args" (Decode.list Decode.text)
171+ <*> Decode.field "type" Type.decoder
151
172
152−-- DECODE ALIAS
153
173
154
174
175+-- ENCODE VALUE
176+
177+
178+encodeValue :: (N.Name, Value) -> Encode.Value
179+encodeValue (name, Value comment tipe) =
180+ Encode.object
181+ [ "name" ==> Encode.text name
182+ , "comment" ==> Encode.text comment
183+ , "type" ==> Type.encode tipe
184+ ]
185+
186+
155−aliasDecoder :: Decode.Decoder Docs.Alias
187+value :: Decode.Decoder Value
156−aliasDecoder =
188+value =
157− Docs.Alias
189+ Value
158− <$> Decode.field "args" (Decode.list Decode.text)
190+ <$> Decode.field "comment" Decode.text
159 <*> Decode.field "type" Type.decoder
191 <*> Decode.field "type" Type.decoder
160
192
161
193
162
194
163−-- ENCODE VALUE
195+-- BINOP
164
196
165
197
166−encodeValue :: ( Text, Docs.Good Docs.GoodValue ) -> Encode.Value
198+encodeBinop :: (N.Name, Binop) -> Encode.Value
167−encodeValue ( name, Docs.Entry comment value ) =
199+encodeBinop (name, Binop comment tipe assoc prec) =
168− Encode.object $
200+ Encode.object
169 [ "name" ==> Encode.text name
201 [ "name" ==> Encode.text name
170 , "comment" ==> Encode.text comment
202 , "comment" ==> Encode.text comment
203+ , "type" ==> Type.encode tipe
204+ , "associativity" ==> encodeAssoc assoc
205+ , "precedence" ==> encodePrec prec
171 ]
206 ]
172− ++
173− case value of
174− Docs.Value tipe ->
175− [ "type" ==> Type.encode tipe
176− ]
177
207
178− Docs.Infix tipe assoc prec ->
208+
179− [ "type" ==> Type.encode tipe
209+binop :: Decode.Decoder Binop
180− , "associativity" ==> Encode.text (Decl.assocToText assoc)
210+binop =
181− , "precedence" ==> Encode.int prec
211+ Binop
182− ]
212+ <$> Decode.field "comment" Decode.text
213+ <*> Decode.field "type" Type.decoder
214+ <*> Decode.field "associativity" assocDecoder
215+ <*> Decode.field "precedence" precDecoder
183
216
184
217
185
218
186−-- DECODE VALUE
219+-- ASSOCIATIVITY
187
220
188
221
189−valueDecoder :: Decode.Decoder Docs.GoodValue
222+encodeAssoc :: Binop.Associativity -> Encode.Value
190−valueDecoder =
223+encodeAssoc assoc =
191− do tipe <- Decode.field "type" Type.decoder
224+ case assoc of
192− Decode.oneOf
225+ Binop.Left -> Encode.text "left"
193− [ Docs.Infix tipe
226+ Binop.Non -> Encode.text "non"
194− <$> Decode.field "associativity" assocDecoder
227+ Binop.Right -> Encode.text "right"
195− <*> Decode.field "precedence" Decode.int
196− , Decode.succeed (Docs.Value tipe)
197− ]
198
228
199
229
200−assocDecoder :: Decode.Decoder Decl.Assoc
230+assocDecoder :: Decode.Decoder Binop.Associativity
201assocDecoder =
231assocDecoder =
202 do txt <- Decode.text
232 do txt <- Decode.text
203 case txt of
233 case txt of
204− "left" -> Decode.succeed Decl.Left
234+ "left" -> Decode.succeed Binop.Left
205− "non" -> Decode.succeed Decl.Non
235+ "non" -> Decode.succeed Binop.Non
206− "right" -> Decode.succeed Decl.Right
236+ "right" -> Decode.succeed Binop.Right
207 _ -> Decode.fail "Expecting an ASSOCIATIVITY (e.g. left, non, right)"
237 _ -> Decode.fail "Expecting an ASSOCIATIVITY (e.g. left, non, right)"
238+
239+
240+
241+-- PRECEDENCE
242+
243+
244+encodePrec :: Binop.Precedence -> Encode.Value
245+encodePrec (Binop.Precedence n) =
246+ Encode.int n
247+
248+
249+precDecoder :: Decode.Decoder Binop.Precedence
250+precDecoder =
251+ Binop.Precedence <$> Decode.int