git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Elm/Docs.hs
205 lines 4.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Docs
4 ( Documentation
5 , Module(..)
6 , toDict
7 , decoder
8 , encode
9 , Docs.Docs(..)
10 , Docs.Checked
11 , Docs.Entry(..)
12 , Docs.Union(..)
13 , Docs.Alias(..)
14 , Docs.Value(..)
15 )
16 where
19import qualified Data.Map as Map
20import Data.Text (Text)
22import qualified AST.Declaration as Decl
23import qualified Docs.AST as Docs
24import qualified Elm.Compiler.Module as Module
25import qualified Elm.Compiler.Type as Type
26import qualified Json.Decode as Decode
27import qualified Json.Encode as Encode
28import Json.Encode ((==>))
32-- DOCUMENTATION
35type Documentation =
36 Map.Map Module.Raw Docs.Checked
39data Module =
40 Module
41 { _name :: !Module.Raw
42 , _docs :: !Docs.Checked
43 }
46toDict :: [Module] -> Documentation
47toDict modules =
48 Map.fromList $ map (\(Module name docs) -> (name, docs)) modules
52-- ENCODE
55encode :: Module -> Encode.Value
56encode (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 ]
67-- DECODE
70decoder :: Decode.Decoder Module
71decoder =
72 Module
73 <$> Decode.field "name" Module.decoder
74 <*> decodeDocs
77decodeDocs :: Decode.Decoder Docs.Checked
78decodeDocs =
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)
86entryDictDecoder :: Decode.Decoder a -> Decode.Decoder (Map.Map Text (Docs.Good a))
87entryDictDecoder subDecoder =
88 Map.fromList <$> Decode.list (entryDecoder subDecoder)
91entryDecoder :: Decode.Decoder a -> Decode.Decoder ( Text, Docs.Good a )
92entryDecoder subDecoder =
93 Decode.map2 (,) (Decode.field "name" Decode.text) $
94 Decode.map2 Docs.Entry (Decode.field "comment" Decode.text) $
95 subDecoder
99-- ENCODE UNION
102encodeUnion :: ( Text, Docs.Good Docs.Union ) -> Encode.Value
103encodeUnion ( name, Docs.Entry comment (Docs.Union args cases) ) =
104 Encode.object
105 [ "name" ==> Encode.text name
106 , "comment" ==> Encode.text comment
107 , "args" ==> Encode.list Encode.text args
108 , "cases" ==> Encode.list encodeCase cases
109 ]
112encodeCase :: ( Text, [Type.Type] ) -> Encode.Value
113encodeCase ( tag, args ) =
114 Encode.list id [ Encode.text tag, Encode.list Type.encode args ]
118-- DECODE UNION
121unionDecoder :: Decode.Decoder Docs.Union
122unionDecoder =
123 Docs.Union
124 <$> Decode.field "args" (Decode.list Decode.text)
125 <*> Decode.field "cases" (Decode.list caseDecoder)
128caseDecoder :: Decode.Decoder ( Text, [Type.Type] )
129caseDecoder =
130 (,)
131 <$> Decode.index 0 Decode.text
132 <*> Decode.index 1 (Decode.list Type.decoder)
136-- ENCODE ALIAS
139encodeAlias :: ( Text, Docs.Good Docs.Alias ) -> Encode.Value
140encodeAlias ( name, Docs.Entry comment (Docs.Alias args tipe) ) =
141 Encode.object
142 [ "name" ==> Encode.text name
143 , "comment" ==> Encode.text comment
144 , "args" ==> Encode.list Encode.text args
145 , "type" ==> Type.encode tipe
146 ]
150-- DECODE ALIAS
153aliasDecoder :: Decode.Decoder Docs.Alias
154aliasDecoder =
155 Docs.Alias
156 <$> Decode.field "args" (Decode.list Decode.text)
157 <*> Decode.field "type" Type.decoder
161-- ENCODE VALUE
164encodeValue :: ( Text, Docs.Good Docs.GoodValue ) -> Encode.Value
165encodeValue ( name, Docs.Entry comment value ) =
166 Encode.object $
167 [ "name" ==> Encode.text name
168 , "comment" ==> Encode.text comment
169 ]
170 ++
171 case value of
172 Docs.Value tipe ->
173 [ "type" ==> Type.encode tipe
174 ]
176 Docs.Infix tipe assoc prec ->
177 [ "type" ==> Type.encode tipe
178 , "associativity" ==> Encode.text (Decl.assocToText assoc)
179 , "precedence" ==> Encode.int prec
180 ]
184-- DECODE VALUE
187valueDecoder :: Decode.Decoder Docs.GoodValue
188valueDecoder =
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 ]
198assocDecoder :: Decode.Decoder Decl.Assoc
199assocDecoder =
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"