git.iko.soy/elk
on c19392f help sign in
elk/src/Elm/Docs.hs
207 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 , Decl.Assoc(..)
16 , Decl.assocToText
17 )
18 where
21import qualified Data.Map as Map
22import Data.Text (Text)
24import qualified AST.Declaration as Decl
25import qualified Docs.AST as Docs
26import qualified Elm.Compiler.Module as Module
27import qualified Elm.Compiler.Type as Type
28import qualified Json.Decode as Decode
29import qualified Json.Encode as Encode
30import Json.Encode ((==>))
34-- DOCUMENTATION
37type Documentation =
38 Map.Map Module.Raw Docs.Checked
41data Module =
42 Module
43 { _name :: !Module.Raw
44 , _docs :: !Docs.Checked
45 }
48toDict :: [Module] -> Documentation
49toDict modules =
50 Map.fromList $ map (\(Module name docs) -> (name, docs)) modules
54-- ENCODE
57encode :: Module -> Encode.Value
58encode (Module name (Docs.Docs overview unions aliases values)) =
59 Encode.object $
60 [ "name" ==> Module.encode name
61 , "comment" ==> Encode.text overview
62 , "types" ==> Encode.list encodeUnion (Map.toList unions)
63 , "aliases" ==> Encode.list encodeAlias (Map.toList aliases)
64 , "values" ==> Encode.list encodeValue (Map.toList values)
65 ]
69-- DECODE
72decoder :: Decode.Decoder Module
73decoder =
74 Module
75 <$> Decode.field "name" Module.decoder
76 <*> decodeDocs
79decodeDocs :: Decode.Decoder Docs.Checked
80decodeDocs =
81 Docs.Docs
82 <$> Decode.field "comment" Decode.text
83 <*> Decode.field "types" (entryDictDecoder unionDecoder)
84 <*> Decode.field "aliases" (entryDictDecoder aliasDecoder)
85 <*> Decode.field "values" (entryDictDecoder valueDecoder)
88entryDictDecoder :: Decode.Decoder a -> Decode.Decoder (Map.Map Text (Docs.Good a))
89entryDictDecoder subDecoder =
90 Map.fromList <$> Decode.list (entryDecoder subDecoder)
93entryDecoder :: Decode.Decoder a -> Decode.Decoder ( Text, Docs.Good a )
94entryDecoder subDecoder =
95 Decode.map2 (,) (Decode.field "name" Decode.text) $
96 Decode.map2 Docs.Entry (Decode.field "comment" Decode.text) $
97 subDecoder
101-- ENCODE UNION
104encodeUnion :: ( Text, Docs.Good Docs.Union ) -> Encode.Value
105encodeUnion ( name, Docs.Entry comment (Docs.Union args cases) ) =
106 Encode.object
107 [ "name" ==> Encode.text name
108 , "comment" ==> Encode.text comment
109 , "args" ==> Encode.list Encode.text args
110 , "cases" ==> Encode.list encodeCase cases
111 ]
114encodeCase :: ( Text, [Type.Type] ) -> Encode.Value
115encodeCase ( tag, args ) =
116 Encode.list id [ Encode.text tag, Encode.list Type.encode args ]
120-- DECODE UNION
123unionDecoder :: Decode.Decoder Docs.Union
124unionDecoder =
125 Docs.Union
126 <$> Decode.field "args" (Decode.list Decode.text)
127 <*> Decode.field "cases" (Decode.list caseDecoder)
130caseDecoder :: Decode.Decoder ( Text, [Type.Type] )
131caseDecoder =
132 (,)
133 <$> Decode.index 0 Decode.text
134 <*> Decode.index 1 (Decode.list Type.decoder)
138-- ENCODE ALIAS
141encodeAlias :: ( Text, Docs.Good Docs.Alias ) -> Encode.Value
142encodeAlias ( name, Docs.Entry comment (Docs.Alias args tipe) ) =
143 Encode.object
144 [ "name" ==> Encode.text name
145 , "comment" ==> Encode.text comment
146 , "args" ==> Encode.list Encode.text args
147 , "type" ==> Type.encode tipe
148 ]
152-- DECODE ALIAS
155aliasDecoder :: Decode.Decoder Docs.Alias
156aliasDecoder =
157 Docs.Alias
158 <$> Decode.field "args" (Decode.list Decode.text)
159 <*> Decode.field "type" Type.decoder
163-- ENCODE VALUE
166encodeValue :: ( Text, Docs.Good Docs.GoodValue ) -> Encode.Value
167encodeValue ( name, Docs.Entry comment value ) =
168 Encode.object $
169 [ "name" ==> Encode.text name
170 , "comment" ==> Encode.text comment
171 ]
172 ++
173 case value of
174 Docs.Value tipe ->
175 [ "type" ==> Type.encode tipe
176 ]
178 Docs.Infix tipe assoc prec ->
179 [ "type" ==> Type.encode tipe
180 , "associativity" ==> Encode.text (Decl.assocToText assoc)
181 , "precedence" ==> Encode.int prec
182 ]
186-- DECODE VALUE
189valueDecoder :: Decode.Decoder Docs.GoodValue
190valueDecoder =
191 do tipe <- Decode.field "type" Type.decoder
192 Decode.oneOf
193 [ Docs.Infix tipe
194 <$> Decode.field "associativity" assocDecoder
195 <*> Decode.field "precedence" Decode.int
196 , Decode.succeed (Docs.Value tipe)
197 ]
200assocDecoder :: Decode.Decoder Decl.Assoc
201assocDecoder =
202 do txt <- Decode.text
203 case txt of
204 "left" -> Decode.succeed Decl.Left
205 "non" -> Decode.succeed Decl.Non
206 "right" -> Decode.succeed Decl.Right
207 _ -> Decode.fail "Expecting an ASSOCIATIVITY (e.g. left, non, right)"