git.iko.soy/elk
on 06e8ede help sign in
elk/compiler/src/Json/Encode.hs
292 lines 5.1 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Json.Encode
4 ( write
5 , encode
6 , writeUgly
7 , encodeUgly
8 , Value(..)
9 , array
10 , object
11 , string
12 , name
13 , chars
14 , bool
15 , int
16 , number
17 , null
18 , dict
19 , list
20 , (==>)
21 )
22 where
25import Prelude hiding (null)
26import Control.Arrow ((***))
27import qualified Data.ByteString.Char8 as BSC
28import qualified Data.ByteString.Builder as B
29import qualified Data.Map as Map
30import qualified Data.Scientific as Sci
31import Data.Monoid ((<>))
32import qualified Data.Name as Name
33import qualified Data.Utf8 as Utf8
35import qualified File
36import qualified Json.String as Json
40-- VALUES
43data Value
44 = Array [Value]
45 | Object [(Json.String, Value)]
46 | String B.Builder
47 | Boolean Bool
48 | Integer Int
49 | Number Sci.Scientific
50 | Null
53array :: [Value] -> Value
54array =
55 Array
58object :: [(Json.String, Value)] -> Value
59object =
60 Object
63string :: Json.String -> Value
64string str =
65 String (B.char7 '"' <> Json.toBuilder str <> B.char7 '"')
68name :: Name.Name -> Value
69name nm =
70 String (B.char7 '"' <> Name.toBuilder nm <> B.char7 '"')
73chars :: [Char] -> Value
74chars chrs =
75 String (B.char7 '"' <> error "TODO escape this properly. Who is using this?" chrs <> B.char7 '"')
78bool :: Bool -> Value
79bool =
80 Boolean
83int :: Int -> Value
84int =
85 Integer
88number :: Sci.Scientific -> Value
89number =
90 Number
93null :: Value
94null =
95 Null
98dict :: (k -> Json.String) -> (v -> Value) -> Map.Map k v -> Value
99dict encodeKey encodeValue pairs =
100 Object $ map (encodeKey *** encodeValue) (Map.toList pairs)
103list :: (a -> Value) -> [a] -> Value
104list encodeEntry entries =
105 Array $ map encodeEntry entries
109-- HELPERS
112(==>) :: [Char] -> value -> (Json.String, value)
113(==>) key value =
114 (Json.fromChars key, value)
118-- WRITE TO FILE
121write :: FilePath -> Value -> IO ()
122write path value =
123 File.writeBuilder path (encode value <> "\n")
126writeUgly :: FilePath -> Value -> IO ()
127writeUgly path value =
128 File.writeBuilder path (encodeUgly value)
132-- ENCODE UGLY
135encodeUgly :: Value -> B.Builder
136encodeUgly value =
137 case value of
138 Array [] ->
139 B.string7 "[]"
141 Array (first : rest) ->
142 let
143 encodeEntry entry =
144 B.char7 ',' <> encodeUgly entry
145 in
146 B.char7 '[' <> encodeUgly first <> mconcat (map encodeEntry rest) <> B.char7 ']'
148 Object [] ->
149 B.string7 "{}"
151 Object (first : rest) ->
152 let
153 encodeEntry char (key, entry) =
154 B.char7 char <> B.char7 '"' <> Utf8.toBuilder key <> B.string7 "\":" <> encodeUgly entry
155 in
156 encodeEntry '{' first <> mconcat (map (encodeEntry ',') rest) <> B.char7 '}'
158 String builder ->
159 builder
161 Boolean boolean ->
162 B.string7 (if boolean then "true" else "false")
164 Integer n ->
165 B.intDec n
167 Number scientific ->
168 B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)
170 Null ->
171 "null"
175-- ENCODE
178encode :: Value -> B.Builder
179encode value =
180 encodeHelp "" value
183encodeHelp :: BSC.ByteString -> Value -> B.Builder
184encodeHelp indent value =
185 case value of
186 Array [] ->
187 B.string7 "[]"
189 Array (first : rest) ->
190 encodeArray indent first rest
192 Object [] ->
193 B.string7 "{}"
195 Object (first : rest) ->
196 encodeObject indent first rest
198 String builder ->
199 builder
201 Boolean boolean ->
202 B.string7 (if boolean then "true" else "false")
204 Integer n ->
205 B.intDec n
207 Number scientific ->
208 B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)
210 Null ->
211 "null"
215-- ENCODE ARRAY
218encodeArray :: BSC.ByteString -> Value -> [Value] -> B.Builder
219encodeArray =
220 encodeSequence arrayOpen arrayClose encodeHelp
223arrayOpen :: B.Builder
224arrayOpen =
225 B.string7 "[\n"
228arrayClose :: B.Builder
229arrayClose =
230 B.char7 ']'
234-- ENCODE OBJECT
237encodeObject :: BSC.ByteString -> (Json.String, Value) -> [(Json.String, Value)] -> B.Builder
238encodeObject =
239 encodeSequence objectOpen objectClose encodeField
242objectOpen :: B.Builder
243objectOpen =
244 B.string7 "{\n"
247objectClose :: B.Builder
248objectClose =
249 B.char7 '}'
252encodeField :: BSC.ByteString -> (Json.String, Value) -> B.Builder
253encodeField indent (key, value) =
254 B.char7 '"' <> Utf8.toBuilder key <> B.string7 "\": " <> encodeHelp indent value
258-- ENCODE SEQUENCE
261encodeSequence :: B.Builder -> B.Builder -> (BSC.ByteString -> a -> B.Builder) -> BSC.ByteString -> a -> [a] -> B.Builder
262encodeSequence open close encodeEntry indent first rest =
263 let
264 newIndent =
265 indent <> " "
267 newIndentBuilder =
268 B.byteString newIndent
270 closer =
271 newline <> B.byteString indent <> close
273 addValue field builder =
274 commaNewline
275 <> newIndentBuilder
276 <> encodeEntry newIndent field
277 <> builder
278 in
279 open
280 <> newIndentBuilder
281 <> encodeEntry newIndent first
282 <> foldr addValue closer rest
285commaNewline :: B.Builder
286commaNewline =
287 B.string7 ",\n"
290newline :: B.Builder
291newline =
292 B.char7 '\n'