@@ -1,218 +1,205 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
33module Elm.Docs
4− ( Documentation(..)
5− , Alias(..)
6− , Union(..)
7− , Value(..)
8− , fromCheckedDocs
4+ ( Documentation
5+ , Module(..)
6+ , toDict
97 , decoder
108 , encode
9+ , Docs.Docs(..)
10+ , Docs.Checked
11+ , Docs.Entry(..)
12+ , Docs.Union(..)
13+ , Docs.Alias(..)
14+ , Docs.Value(..)
1115 )
1216 where
1317
18+
1419import qualified Data.Map as Map
1520import Data.Text (Text)
1621
22+import qualified AST.Declaration as Decl
1723import qualified Docs.AST as Docs
1824import qualified Elm.Compiler.Module as Module
1925import qualified Elm.Compiler.Type as Type
20−import qualified Elm.Compiler.Version as Version
21−import qualified Elm.Package as Pkg
2226import qualified Json.Decode as Decode
2327import qualified Json.Encode as Encode
2428import Json.Encode ((==>))
2529
2630
2731
28−-- DATA STRUCTURES
32+-- DOCUMENTATION
2933
3034
31−data Documentation =
32− Documentation
33− { _name :: Module.Raw
34− , _comment :: Text
35− , _aliases :: [Alias]
36− , _types :: [Union]
37− , _values :: [Value]
38− , _version :: Maybe Pkg.Version
39− }
35+type Documentation =
36+ Map.Map Module.Raw Docs.Checked
4037
4138
42−data Alias =
43− Alias
44− { _a_name :: Text
45− , _a_comment :: Text
46− , _a_args :: [Text]
47− , _a_type :: Type.Type
39+data Module =
40+ Module
41+ { _name :: !Module.Raw
42+ , _docs :: !Docs.Checked
4843 }
4944
5045
51−data Union =
52− Union
53− { _u_name :: Text
54− , _u_comment :: Text
55− , _u_args :: [Text]
56− , _u_cases :: [(Text, [Type.Type])]
57− }
58−
46+toDict :: [Module] -> Documentation
47+toDict modules =
48+ Map.fromList $ map (\(Module name docs) -> (name, docs)) modules
5949
60−data Value =
61− Value
62− { _v_name :: Text
63− , _v_comment :: Text
64− , _v_type :: Type.Type
65− , _v_fix :: Maybe (Text,Int)
66− }
6750
6851
52+-- ENCODE
6953
70−-- FROM CHECKED DOCS
7154
55+encode :: Module -> Encode.Value
56+encode (Module name (Docs.Docs overview unions aliases values)) =
57+ Encode.object $
58+ [ "name" ==> Module.encode name
59+ , "comment" ==> Encode.text overview
60+ , "types" ==> Encode.list encodeUnion (Map.toList unions)
61+ , "aliases" ==> Encode.list encodeAlias (Map.toList aliases)
62+ , "values" ==> Encode.list encodeValue (Map.toList values)
63+ ]
7264
73−fromCheckedDocs :: Module.Raw -> Docs.Checked -> Documentation
74−fromCheckedDocs name (Docs.Checked comment values aliases unions) =
75− let
76− toValue (vName, Docs.Value vComment tipe fix) =
77− Value vName vComment tipe fix
7865
79− toAlias (aName, Docs.Alias aComment args tipe) =
80− Alias aName aComment args tipe
8166
82− toUnion (uName, Docs.Union uComment args cases) =
83− Union uName uComment args cases
84− in
85− Documentation
86− name
87− comment
88− (map toAlias (Map.toList aliases))
89− (map toUnion (Map.toList unions))
90− (map toValue (Map.toList values))
91− (Just Version.version)
67+-- DECODE
9268
9369
70+decoder :: Decode.Decoder Module
71+decoder =
72+ Module
73+ <$> Decode.field "name" Module.decoder
74+ <*> decodeDocs
9475
95−-- JSON
9676
77+decodeDocs :: Decode.Decoder Docs.Checked
78+decodeDocs =
79+ Docs.Docs
80+ <$> Decode.field "comment" Decode.text
81+ <*> Decode.field "types" (entryDictDecoder unionDecoder)
82+ <*> Decode.field "aliases" (entryDictDecoder aliasDecoder)
83+ <*> Decode.field "values" (entryDictDecoder valueDecoder)
9784
98−encode :: Documentation -> Encode.Value
99−encode (Documentation name comment aliases types values elmVersion) =
100− Encode.object $
101− [ "name" ==> Module.encode name
102− , "comment" ==> Encode.text comment
103− , "aliases" ==> Encode.list encodeAlias aliases
104− , "types" ==> Encode.list encodeUnion types
105− , "values" ==> Encode.list encodeValue values
106− ]
107− ++
108− case elmVersion of
109− Nothing ->
110− []
11185
112− Just version ->
113− [ "generated-with-elm-version" ==> Pkg.encodeVersion version
114− ]
86+entryDictDecoder :: Decode.Decoder a -> Decode.Decoder (Map.Map Text (Docs.Good a))
87+entryDictDecoder subDecoder =
88+ Map.fromList <$> Decode.list (entryDecoder subDecoder)
11589
11690
117−decoder :: Decode.Decoder Documentation
118−decoder =
119− Documentation
120− <$> Decode.field "name" Module.decoder
121− <*> Decode.field "comment" Decode.text
122− <*> Decode.field "aliases" (Decode.list aliasDecoder)
123− <*> Decode.field "types" (Decode.list unionDecoder)
124− <*> Decode.field "values" (Decode.list valueDecoder)
125− <*> Decode.maybe (Decode.field "generated-with-elm-version" Pkg.versionDecoder)
91+entryDecoder :: Decode.Decoder a -> Decode.Decoder ( Text, Docs.Good a )
92+entryDecoder subDecoder =
93+ Decode.map2 (,) (Decode.field "name" Decode.text) $
94+ Decode.map2 Docs.Entry (Decode.field "comment" Decode.text) $
95+ subDecoder
12696
12797
12898
129−-- JSON for ALIAS
99+-- ENCODE UNION
130100
131101
132−encodeAlias :: Alias -> Encode.Value
133−encodeAlias (Alias name comment args tipe) =
102+encodeUnion :: ( Text, Docs.Good Docs.Union ) -> Encode.Value
103+encodeUnion ( name, Docs.Entry comment (Docs.Union args cases) ) =
134104 Encode.object
135105 [ "name" ==> Encode.text name
136106 , "comment" ==> Encode.text comment
137107 , "args" ==> Encode.list Encode.text args
138− , "type" ==> Type.encode tipe
108+ , "cases" ==> Encode.list encodeCase cases
139109 ]
140110
141111
142−aliasDecoder :: Decode.Decoder Alias
143−aliasDecoder =
144− Alias
145− <$> Decode.field "name" Decode.text
146− <*> Decode.field "comment" Decode.text
147− <*> Decode.field "args" (Decode.list Decode.text)
148− <*> Decode.field "type" Type.decoder
112+encodeCase :: ( Text, [Type.Type] ) -> Encode.Value
113+encodeCase ( tag, args ) =
114+ Encode.list id [ Encode.text tag, Encode.list Type.encode args ]
115+
116+
117+
118+-- DECODE UNION
119+
120+
121+unionDecoder :: Decode.Decoder Docs.Union
122+unionDecoder =
123+ Docs.Union
124+ <$> Decode.field "args" (Decode.list Decode.text)
125+ <*> Decode.field "cases" (Decode.list caseDecoder)
149126
150127
128+caseDecoder :: Decode.Decoder ( Text, [Type.Type] )
129+caseDecoder =
130+ (,)
131+ <$> Decode.index 0 Decode.text
132+ <*> Decode.index 1 (Decode.list Type.decoder)
133+
151134
152−-- JSON for UNION
153135
136+-- ENCODE ALIAS
154137
155−encodeUnion :: Union -> Encode.Value
156−encodeUnion (Union name comment args cases) =
138+
139+encodeAlias :: ( Text, Docs.Good Docs.Alias ) -> Encode.Value
140+encodeAlias ( name, Docs.Entry comment (Docs.Alias args tipe) ) =
157141 Encode.object
158142 [ "name" ==> Encode.text name
159143 , "comment" ==> Encode.text comment
160144 , "args" ==> Encode.list Encode.text args
161− , "cases" ==> Encode.list encodeCase cases
145+ , "type" ==> Type.encode tipe
162146 ]
163147
164148
165−unionDecoder :: Decode.Decoder Union
166−unionDecoder =
167− Union
168− <$> Decode.field "name" Decode.text
169− <*> Decode.field "comment" Decode.text
170− <*> Decode.field "args" (Decode.list Decode.text)
171− <*> Decode.field "cases" (Decode.list caseDecoder)
172−
173149
174−encodeCase :: ( Text, [Type.Type] ) -> Encode.Value
175−encodeCase ( tag, args ) =
176− Encode.list id [ Encode.text tag, Encode.list Type.encode args ]
150+-- DECODE ALIAS
177151
178152
179−caseDecoder :: Decode.Decoder ( Text, [Type.Type] )
180−caseDecoder =
181− (,)
182− <$> Decode.index 0 Decode.text
183− <*> Decode.index 1 (Decode.list Type.decoder)
153+aliasDecoder :: Decode.Decoder Docs.Alias
154+aliasDecoder =
155+ Docs.Alias
156+ <$> Decode.field "args" (Decode.list Decode.text)
157+ <*> Decode.field "type" Type.decoder
184158
185159
186160
187−-- JSON for VALUE
161+-- ENCODE VALUE
188162
189163
190−encodeValue :: Value -> Encode.Value
191−encodeValue (Value name comment tipe assocPrec) =
164+encodeValue :: ( Text, Docs.Good Docs.GoodValue ) -> Encode.Value
165+encodeValue ( name, Docs.Entry comment value ) =
192166 Encode.object $
193167 [ "name" ==> Encode.text name
194168 , "comment" ==> Encode.text comment
195− , "type" ==> Type.encode tipe
196169 ]
197170 ++
198− case assocPrec of
199− Nothing ->
200− []
171+ case value of
172+ Docs.Value tipe ->
173+ [ "type" ==> Type.encode tipe
174+ ]
201175
202− Just (assoc, prec) ->
203− [ "associativity" ==> Encode.text assoc
176+ Docs.Infix tipe assoc prec ->
177+ [ "type" ==> Type.encode tipe
178+ , "associativity" ==> Encode.text (Decl.assocToText assoc)
204179 , "precedence" ==> Encode.int prec
205180 ]
206181
207182
208−valueDecoder :: Decode.Decoder Value
183+
184+-- DECODE VALUE
185+
186+
187+valueDecoder :: Decode.Decoder Docs.GoodValue
209188valueDecoder =
210− Value
211− <$> Decode.field "name" Decode.text
212− <*> Decode.field "comment" Decode.text
213− <*> Decode.field "type" Type.decoder
214− <*> Decode.maybe (
215− (,)
216− <$> Decode.field "associativity" Decode.text
217− <*> Decode.field "precedence" Decode.int
218− )
189+ do tipe <- Decode.field "type" Type.decoder
190+ Decode.oneOf
191+ [ Docs.Infix tipe
192+ <$> Decode.field "associativity" assocDecoder
193+ <*> Decode.field "precedence" Decode.int
194+ , Decode.succeed (Docs.Value tipe)
195+ ]
196+
197+
198+assocDecoder :: Decode.Decoder Decl.Assoc
199+assocDecoder =
200+ do txt <- Decode.text
201+ case txt of
202+ "left" -> Decode.succeed Decl.Left
203+ "non" -> Decode.succeed Decl.Non
204+ "right" -> Decode.succeed Decl.Right
205+ _ -> Decode.fail "an associativity"