git.iko.soy/elk
on 075be13 help sign in
elk/compiler/src/Json/Encode.hs
309 lines 5.4 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 '"')
73bool :: Bool -> Value
74bool =
75 Boolean
78int :: Int -> Value
79int =
80 Integer
83number :: Sci.Scientific -> Value
84number =
85 Number
88null :: Value
89null =
90 Null
93dict :: (k -> Json.String) -> (v -> Value) -> Map.Map k v -> Value
94dict encodeKey encodeValue pairs =
95 Object $ map (encodeKey *** encodeValue) (Map.toList pairs)
98list :: (a -> Value) -> [a] -> Value
99list encodeEntry entries =
100 Array $ map encodeEntry entries
104-- CHARS
107chars :: [Char] -> Value -- TODO can this be done better? Look for examples.
108chars chrs =
109 String (B.char7 '"' <> B.stringUtf8 (escape chrs) <> B.char7 '"')
112escape :: [Char] -> [Char] -- TODO is this correct?
113escape chrs =
114 case chrs of
115 [] ->
116 []
118 c:cs
119 | c == '\n' -> '\\' : 'n' : escape cs
120 | c == '\"' -> '\\' : '"' : escape cs
121 | c == '\'' -> '\\' : '\'' : escape cs
122 | otherwise -> c : escape cs
126-- HELPERS
129(==>) :: [Char] -> value -> (Json.String, value)
130(==>) key value =
131 (Json.fromChars key, value)
135-- WRITE TO FILE
138write :: FilePath -> Value -> IO ()
139write path value =
140 File.writeBuilder path (encode value <> "\n")
143writeUgly :: FilePath -> Value -> IO ()
144writeUgly path value =
145 File.writeBuilder path (encodeUgly value)
149-- ENCODE UGLY
152encodeUgly :: Value -> B.Builder
153encodeUgly value =
154 case value of
155 Array [] ->
156 B.string7 "[]"
158 Array (first : rest) ->
159 let
160 encodeEntry entry =
161 B.char7 ',' <> encodeUgly entry
162 in
163 B.char7 '[' <> encodeUgly first <> mconcat (map encodeEntry rest) <> B.char7 ']'
165 Object [] ->
166 B.string7 "{}"
168 Object (first : rest) ->
169 let
170 encodeEntry char (key, entry) =
171 B.char7 char <> B.char7 '"' <> Utf8.toBuilder key <> B.string7 "\":" <> encodeUgly entry
172 in
173 encodeEntry '{' first <> mconcat (map (encodeEntry ',') rest) <> B.char7 '}'
175 String builder ->
176 builder
178 Boolean boolean ->
179 B.string7 (if boolean then "true" else "false")
181 Integer n ->
182 B.intDec n
184 Number scientific ->
185 B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)
187 Null ->
188 "null"
192-- ENCODE
195encode :: Value -> B.Builder
196encode value =
197 encodeHelp "" value
200encodeHelp :: BSC.ByteString -> Value -> B.Builder
201encodeHelp indent value =
202 case value of
203 Array [] ->
204 B.string7 "[]"
206 Array (first : rest) ->
207 encodeArray indent first rest
209 Object [] ->
210 B.string7 "{}"
212 Object (first : rest) ->
213 encodeObject indent first rest
215 String builder ->
216 builder
218 Boolean boolean ->
219 B.string7 (if boolean then "true" else "false")
221 Integer n ->
222 B.intDec n
224 Number scientific ->
225 B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)
227 Null ->
228 "null"
232-- ENCODE ARRAY
235encodeArray :: BSC.ByteString -> Value -> [Value] -> B.Builder
236encodeArray =
237 encodeSequence arrayOpen arrayClose encodeHelp
240arrayOpen :: B.Builder
241arrayOpen =
242 B.string7 "[\n"
245arrayClose :: B.Builder
246arrayClose =
247 B.char7 ']'
251-- ENCODE OBJECT
254encodeObject :: BSC.ByteString -> (Json.String, Value) -> [(Json.String, Value)] -> B.Builder
255encodeObject =
256 encodeSequence objectOpen objectClose encodeField
259objectOpen :: B.Builder
260objectOpen =
261 B.string7 "{\n"
264objectClose :: B.Builder
265objectClose =
266 B.char7 '}'
269encodeField :: BSC.ByteString -> (Json.String, Value) -> B.Builder
270encodeField indent (key, value) =
271 B.char7 '"' <> Utf8.toBuilder key <> B.string7 "\": " <> encodeHelp indent value
275-- ENCODE SEQUENCE
278encodeSequence :: B.Builder -> B.Builder -> (BSC.ByteString -> a -> B.Builder) -> BSC.ByteString -> a -> [a] -> B.Builder
279encodeSequence open close encodeEntry indent first rest =
280 let
281 newIndent =
282 indent <> " "
284 newIndentBuilder =
285 B.byteString newIndent
287 closer =
288 newline <> B.byteString indent <> close
290 addValue field builder =
291 commaNewline
292 <> newIndentBuilder
293 <> encodeEntry newIndent field
294 <> builder
295 in
296 open
297 <> newIndentBuilder
298 <> encodeEntry newIndent first
299 <> foldr addValue closer rest
302commaNewline :: B.Builder
303commaNewline =
304 B.string7 ",\n"
307newline :: B.Builder
308newline =
309 B.char7 '\n'