git.iko.soy/elk
on cb359fa help sign in
elk/compiler/src/Json/Encode.hs
295 lines 5.0 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
33import System.IO (IOMode(WriteMode), withBinaryFile)
37-- VALUES
40data Value
41 = Array [Value]
42 | Object [(Utf8.String, Value)]
43 | String B.Builder
44 | Boolean Bool
45 | Integer Int
46 | Number Sci.Scientific
47 | Null
50array :: [Value] -> Value
51array =
52 Array
55object :: [(Utf8.String,Value)] -> Value
56object =
57 Object
60string :: Utf8.String -> Value
61string str =
62 String (encodeUtf8 str)
65name :: Name.Name -> Value
66name nm =
67 String (B.char7 '"' <> Name.toBuilder nm <> B.char7 '"')
70bool :: Bool -> Value
71bool =
72 Boolean
75int :: Int -> Value
76int =
77 Integer
80number :: Sci.Scientific -> Value
81number =
82 Number
85null :: Value
86null =
87 Null
90dict :: (k -> Utf8.String) -> (v -> Value) -> Map.Map k v -> Value
91dict encodeKey encodeValue pairs =
92 Object $ map (encodeKey *** encodeValue) (Map.toList pairs)
95list :: (a -> Value) -> [a] -> Value
96list encodeEntry entries =
97 Array $ map encodeEntry entries
101-- HELPERS
104(==>) :: a -> b -> (a, b)
105(==>) a b =
106 (a, b)
110-- WRITE TO FILE
113write :: FilePath -> Value -> IO ()
114write path value =
115 withBinaryFile path WriteMode $ \handle ->
116 B.hPutBuilder handle (encode value <> "\n")
119writeUgly :: FilePath -> Value -> IO ()
120writeUgly path value =
121 withBinaryFile path WriteMode $ \handle ->
122 B.hPutBuilder handle (encodeUgly value)
126-- ENCODE UGLY
129encodeUgly :: Value -> B.Builder
130encodeUgly value =
131 case value of
132 Array [] ->
133 B.string7 "[]"
135 Array (first : rest) ->
136 let
137 encodeEntry entry =
138 B.char7 ',' <> encodeUgly entry
139 in
140 B.char7 '[' <> encodeUgly first <> mconcat (map encodeEntry rest) <> B.char7 ']'
142 Object [] ->
143 B.string7 "{}"
145 Object (first : rest) ->
146 let
147 encodeEntry char (key, entry) =
148 B.char7 char <> encodeUtf8 key <> B.char7 ':' <> encodeUgly entry
149 in
150 encodeEntry '{' first <> mconcat (map (encodeEntry ',') rest) <> B.char7 '}'
152 String builder ->
153 builder
155 Boolean boolean ->
156 B.string7 (if boolean then "true" else "false")
158 Integer n ->
159 B.intDec n
161 Number scientific ->
162 B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)
164 Null ->
165 "null"
169-- ENCODE
172encode :: Value -> B.Builder
173encode value =
174 encodeHelp "" value
177encodeHelp :: BSC.ByteString -> Value -> B.Builder
178encodeHelp indent value =
179 case value of
180 Array [] ->
181 B.string7 "[]"
183 Array (first : rest) ->
184 encodeArray indent first rest
186 Object [] ->
187 B.string7 "{}"
189 Object (first : rest) ->
190 encodeObject indent first rest
192 String builder ->
193 builder
195 Boolean boolean ->
196 B.string7 (if boolean then "true" else "false")
198 Integer n ->
199 B.intDec n
201 Number scientific ->
202 B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)
204 Null ->
205 "null"
209-- ENCODE UTF-8
212encodeUtf8 :: Utf8.String -> B.Builder
213encodeUtf8 str =
214 B.char7 '"' <> Utf8.toBuilder str <> B.char7 '"'
218-- ENCODE ARRAY
221encodeArray :: BSC.ByteString -> Value -> [Value] -> B.Builder
222encodeArray =
223 encodeSequence arrayOpen arrayClose encodeHelp
226arrayOpen :: B.Builder
227arrayOpen =
228 B.string7 "[\n"
231arrayClose :: B.Builder
232arrayClose =
233 B.char7 ']'
237-- ENCODE OBJECT
240encodeObject :: BSC.ByteString -> (Utf8.String, Value) -> [(Utf8.String, Value)] -> B.Builder
241encodeObject =
242 encodeSequence objectOpen objectClose encodeField
245objectOpen :: B.Builder
246objectOpen =
247 B.string7 "{\n"
250objectClose :: B.Builder
251objectClose =
252 B.char7 '}'
255encodeField :: BSC.ByteString -> (Utf8.String, Value) -> B.Builder
256encodeField indent (key, value) =
257 encodeUtf8 key <> B.string7 ": " <> encodeHelp indent value
261-- ENCODE SEQUENCE
264encodeSequence :: B.Builder -> B.Builder -> (BSC.ByteString -> a -> B.Builder) -> BSC.ByteString -> a -> [a] -> B.Builder
265encodeSequence open close encodeEntry indent first rest =
266 let
267 newIndent =
268 indent <> " "
270 newIndentBuilder =
271 B.byteString newIndent
273 closer =
274 newline <> B.byteString indent <> close
276 addValue field builder =
277 commaNewline
278 <> newIndentBuilder
279 <> encodeEntry newIndent field
280 <> builder
281 in
282 open
283 <> newIndentBuilder
284 <> encodeEntry newIndent first
285 <> foldr addValue closer rest
288commaNewline :: B.Builder
289commaNewline =
290 B.string7 ",\n"
293newline :: B.Builder
294newline =
295 B.char7 '\n'