git.iko.soy/elk
on 253bb13 help sign in
elk/compiler/src/Json/Encode.hs
294 lines 4.9 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 , bool
14 , int
15 , number
16 , null
17 , dict
18 , list
19 , (==>)
20 )
21 where
24import Prelude hiding (null)
25import Control.Arrow ((***))
26import qualified Data.ByteString.Char8 as BSC
27import qualified Data.ByteString.Builder as B
28import qualified Data.Map as Map
29import qualified Data.Scientific as Sci
30import Data.Monoid ((<>))
31import qualified Data.Name as Name
32import qualified Data.Utf8 as Utf8
34import qualified File
38-- VALUES
41data Value
42 = Array [Value]
43 | Object [(Utf8.String, Value)]
44 | String B.Builder
45 | Boolean Bool
46 | Integer Int
47 | Number Sci.Scientific
48 | Null
51array :: [Value] -> Value
52array =
53 Array
56object :: [(Utf8.String,Value)] -> Value
57object =
58 Object
61string :: Utf8.String -> Value
62string str =
63 String (encodeUtf8 str)
66name :: Name.Name -> Value
67name nm =
68 String (B.char7 '"' <> Name.toBuilder nm <> B.char7 '"')
71bool :: Bool -> Value
72bool =
73 Boolean
76int :: Int -> Value
77int =
78 Integer
81number :: Sci.Scientific -> Value
82number =
83 Number
86null :: Value
87null =
88 Null
91dict :: (k -> Utf8.String) -> (v -> Value) -> Map.Map k v -> Value
92dict encodeKey encodeValue pairs =
93 Object $ map (encodeKey *** encodeValue) (Map.toList pairs)
96list :: (a -> Value) -> [a] -> Value
97list encodeEntry entries =
98 Array $ map encodeEntry entries
102-- HELPERS
105(==>) :: a -> b -> (a, b)
106(==>) a b =
107 (a, b)
111-- WRITE TO FILE
114write :: FilePath -> Value -> IO ()
115write path value =
116 File.writeBuilder path (encode value <> "\n")
119writeUgly :: FilePath -> Value -> IO ()
120writeUgly path value =
121 File.writeBuilder path (encodeUgly value)
125-- ENCODE UGLY
128encodeUgly :: Value -> B.Builder
129encodeUgly value =
130 case value of
131 Array [] ->
132 B.string7 "[]"
134 Array (first : rest) ->
135 let
136 encodeEntry entry =
137 B.char7 ',' <> encodeUgly entry
138 in
139 B.char7 '[' <> encodeUgly first <> mconcat (map encodeEntry rest) <> B.char7 ']'
141 Object [] ->
142 B.string7 "{}"
144 Object (first : rest) ->
145 let
146 encodeEntry char (key, entry) =
147 B.char7 char <> encodeUtf8 key <> B.char7 ':' <> encodeUgly entry
148 in
149 encodeEntry '{' first <> mconcat (map (encodeEntry ',') rest) <> B.char7 '}'
151 String builder ->
152 builder
154 Boolean boolean ->
155 B.string7 (if boolean then "true" else "false")
157 Integer n ->
158 B.intDec n
160 Number scientific ->
161 B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)
163 Null ->
164 "null"
168-- ENCODE
171encode :: Value -> B.Builder
172encode value =
173 encodeHelp "" value
176encodeHelp :: BSC.ByteString -> Value -> B.Builder
177encodeHelp indent value =
178 case value of
179 Array [] ->
180 B.string7 "[]"
182 Array (first : rest) ->
183 encodeArray indent first rest
185 Object [] ->
186 B.string7 "{}"
188 Object (first : rest) ->
189 encodeObject indent first rest
191 String builder ->
192 builder
194 Boolean boolean ->
195 B.string7 (if boolean then "true" else "false")
197 Integer n ->
198 B.intDec n
200 Number scientific ->
201 B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)
203 Null ->
204 "null"
208-- ENCODE UTF-8
211encodeUtf8 :: Utf8.String -> B.Builder
212encodeUtf8 str =
213 B.char7 '"' <> Utf8.toBuilder str <> B.char7 '"'
217-- ENCODE ARRAY
220encodeArray :: BSC.ByteString -> Value -> [Value] -> B.Builder
221encodeArray =
222 encodeSequence arrayOpen arrayClose encodeHelp
225arrayOpen :: B.Builder
226arrayOpen =
227 B.string7 "[\n"
230arrayClose :: B.Builder
231arrayClose =
232 B.char7 ']'
236-- ENCODE OBJECT
239encodeObject :: BSC.ByteString -> (Utf8.String, Value) -> [(Utf8.String, Value)] -> B.Builder
240encodeObject =
241 encodeSequence objectOpen objectClose encodeField
244objectOpen :: B.Builder
245objectOpen =
246 B.string7 "{\n"
249objectClose :: B.Builder
250objectClose =
251 B.char7 '}'
254encodeField :: BSC.ByteString -> (Utf8.String, Value) -> B.Builder
255encodeField indent (key, value) =
256 encodeUtf8 key <> B.string7 ": " <> encodeHelp indent value
260-- ENCODE SEQUENCE
263encodeSequence :: B.Builder -> B.Builder -> (BSC.ByteString -> a -> B.Builder) -> BSC.ByteString -> a -> [a] -> B.Builder
264encodeSequence open close encodeEntry indent first rest =
265 let
266 newIndent =
267 indent <> " "
269 newIndentBuilder =
270 B.byteString newIndent
272 closer =
273 newline <> B.byteString indent <> close
275 addValue field builder =
276 commaNewline
277 <> newIndentBuilder
278 <> encodeEntry newIndent field
279 <> builder
280 in
281 open
282 <> newIndentBuilder
283 <> encodeEntry newIndent first
284 <> foldr addValue closer rest
287commaNewline :: B.Builder
288commaNewline =
289 B.string7 ",\n"
292newline :: B.Builder
293newline =
294 B.char7 '\n'