git.iko.soy/elk
on ebbecaf help sign in
elk/compiler/src/Json/Encode.hs
310 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 -- PERF can this be done better? Look for examples.
108chars chrs =
109 String (B.char7 '"' <> B.stringUtf8 (escape chrs) <> B.char7 '"')
112escape :: [Char] -> [Char]
113escape chrs =
114 case chrs of
115 [] ->
116 []
118 c:cs
119 | c == '\r' -> '\\' : 'r' : escape cs
120 | c == '\n' -> '\\' : 'n' : escape cs
121 | c == '\"' -> '\\' : '"' : escape cs
122 | c == '\\' -> '\\' : '\\' : escape cs
123 | otherwise -> c : escape cs
127-- HELPERS
130(==>) :: [Char] -> value -> (Json.String, value)
131(==>) key value =
132 (Json.fromChars key, value)
136-- WRITE TO FILE
139write :: FilePath -> Value -> IO ()
140write path value =
141 File.writeBuilder path (encode value <> "\n")
144writeUgly :: FilePath -> Value -> IO ()
145writeUgly path value =
146 File.writeBuilder path (encodeUgly value)
150-- ENCODE UGLY
153encodeUgly :: Value -> B.Builder
154encodeUgly value =
155 case value of
156 Array [] ->
157 B.string7 "[]"
159 Array (first : rest) ->
160 let
161 encodeEntry entry =
162 B.char7 ',' <> encodeUgly entry
163 in
164 B.char7 '[' <> encodeUgly first <> mconcat (map encodeEntry rest) <> B.char7 ']'
166 Object [] ->
167 B.string7 "{}"
169 Object (first : rest) ->
170 let
171 encodeEntry char (key, entry) =
172 B.char7 char <> B.char7 '"' <> Utf8.toBuilder key <> B.string7 "\":" <> encodeUgly entry
173 in
174 encodeEntry '{' first <> mconcat (map (encodeEntry ',') rest) <> B.char7 '}'
176 String builder ->
177 builder
179 Boolean boolean ->
180 B.string7 (if boolean then "true" else "false")
182 Integer n ->
183 B.intDec n
185 Number scientific ->
186 B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)
188 Null ->
189 "null"
193-- ENCODE
196encode :: Value -> B.Builder
197encode value =
198 encodeHelp "" value
201encodeHelp :: BSC.ByteString -> Value -> B.Builder
202encodeHelp indent value =
203 case value of
204 Array [] ->
205 B.string7 "[]"
207 Array (first : rest) ->
208 encodeArray indent first rest
210 Object [] ->
211 B.string7 "{}"
213 Object (first : rest) ->
214 encodeObject indent first rest
216 String builder ->
217 builder
219 Boolean boolean ->
220 B.string7 (if boolean then "true" else "false")
222 Integer n ->
223 B.intDec n
225 Number scientific ->
226 B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)
228 Null ->
229 "null"
233-- ENCODE ARRAY
236encodeArray :: BSC.ByteString -> Value -> [Value] -> B.Builder
237encodeArray =
238 encodeSequence arrayOpen arrayClose encodeHelp
241arrayOpen :: B.Builder
242arrayOpen =
243 B.string7 "[\n"
246arrayClose :: B.Builder
247arrayClose =
248 B.char7 ']'
252-- ENCODE OBJECT
255encodeObject :: BSC.ByteString -> (Json.String, Value) -> [(Json.String, Value)] -> B.Builder
256encodeObject =
257 encodeSequence objectOpen objectClose encodeField
260objectOpen :: B.Builder
261objectOpen =
262 B.string7 "{\n"
265objectClose :: B.Builder
266objectClose =
267 B.char7 '}'
270encodeField :: BSC.ByteString -> (Json.String, Value) -> B.Builder
271encodeField indent (key, value) =
272 B.char7 '"' <> Utf8.toBuilder key <> B.string7 "\": " <> encodeHelp indent value
276-- ENCODE SEQUENCE
279encodeSequence :: B.Builder -> B.Builder -> (BSC.ByteString -> a -> B.Builder) -> BSC.ByteString -> a -> [a] -> B.Builder
280encodeSequence open close encodeEntry indent first rest =
281 let
282 newIndent =
283 indent <> " "
285 newIndentBuilder =
286 B.byteString newIndent
288 closer =
289 newline <> B.byteString indent <> close
291 addValue field builder =
292 commaNewline
293 <> newIndentBuilder
294 <> encodeEntry newIndent field
295 <> builder
296 in
297 open
298 <> newIndentBuilder
299 <> encodeEntry newIndent first
300 <> foldr addValue closer rest
303commaNewline :: B.Builder
304commaNewline =
305 B.string7 ",\n"
308newline :: B.Builder
309newline =
310 B.char7 '\n'