git.iko.soy/elk
on 11bd592 help sign in
elk/src/Json/Encode.hs
244 lines 4.1 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Json.Encode
4 ( write
5 , encode
6 , Value
7 , array
8 , object
9 , text
10 , string
11 , bool
12 , dict
13 , list
14 )
15 where
18import Control.Arrow ((***))
19import qualified Data.ByteString.Char8 as BSC
20import qualified Data.ByteString.Builder as B
21import qualified Data.Map as Map
22import Data.Monoid ((<>))
23import qualified Data.Text as Text
24import qualified Numeric
25import System.IO (IOMode(WriteMode), withBinaryFile)
29-- VALUES
32data Value
33 = Array [Value]
34 | Object [(String, Value)]
35 | String B.Builder
36 | Boolean Bool
39array :: [Value] -> Value
40array =
41 Array
44object :: [(String,Value)] -> Value
45object =
46 Object
49text :: Text.Text -> Value
50text txt =
51 String (encodeString (Text.unpack txt))
54string :: String -> Value
55string str =
56 String (encodeString str)
59bool :: Bool -> Value
60bool =
61 Boolean
64dict :: (k -> String) -> (v -> Value) -> Map.Map k v -> Value
65dict encodeKey encodeValue pairs =
66 Object $ map (encodeKey *** encodeValue) (Map.toList pairs)
69list :: (a -> Value) -> [a] -> Value
70list encodeEntry entries =
71 Array $ map encodeEntry entries
75-- WRITE TO FILE
78write :: FilePath -> Value -> IO ()
79write path value =
80 withBinaryFile path WriteMode $ \handle ->
81 B.hPutBuilder handle (encode value)
85-- ENCODE
88encode :: Value -> B.Builder
89encode value =
90 encodeHelp "" value
93encodeHelp :: BSC.ByteString -> Value -> B.Builder
94encodeHelp indent value =
95 case value of
96 Array [] ->
97 B.string7 "[]"
99 Array (first : rest) ->
100 encodeArray indent first rest
102 Object [] ->
103 B.string7 "{}"
105 Object (first : rest) ->
106 encodeObject indent first rest
108 String builder ->
109 builder
111 Boolean boolean ->
112 B.string7 (if boolean then "true" else "false")
116-- ENCODE ARRAY
119encodeArray :: BSC.ByteString -> Value -> [Value] -> B.Builder
120encodeArray =
121 encodeSequence arrayOpen arrayClose encodeHelp
124arrayOpen :: B.Builder
125arrayOpen =
126 B.string7 "[\n"
129arrayClose :: B.Builder
130arrayClose =
131 B.char7 ']'
135-- ENCODE OBJECT
138encodeObject :: BSC.ByteString -> (String, Value) -> [(String, Value)] -> B.Builder
139encodeObject =
140 encodeSequence objectOpen objectClose encodeField
143objectOpen :: B.Builder
144objectOpen =
145 B.string7 "{\n"
148objectClose :: B.Builder
149objectClose =
150 B.char7 '}'
153encodeField :: BSC.ByteString -> (String, Value) -> B.Builder
154encodeField indent (key, value) =
155 encodeString key <> B.string7 ": " <> encodeHelp indent value
159-- ENCODE SEQUENCE
162encodeSequence :: B.Builder -> B.Builder -> (BSC.ByteString -> a -> B.Builder) -> BSC.ByteString -> a -> [a] -> B.Builder
163encodeSequence open close encodeEntry indent first rest =
164 let
165 newIndent =
166 indent <> "\t"
168 newIndentBuilder =
169 B.byteString newIndent
171 closer =
172 newline <> B.byteString indent <> close
174 addValue field builder =
175 builder
176 <> commaNewline
177 <> newIndentBuilder
178 <> encodeEntry newIndent field
179 in
180 open
181 <> newIndentBuilder
182 <> encodeEntry newIndent first
183 <> foldr addValue closer rest
186commaNewline :: B.Builder
187commaNewline =
188 B.string7 ",\n"
191newline :: B.Builder
192newline =
193 B.char7 '\n'
197-- ENCODE STRING
200encodeString :: String -> B.Builder
201encodeString str =
202 B.char7 '"' <> escape str <> B.char7 '"'
205escape :: String -> B.Builder
206escape str =
207 let
208 (front, back) =
209 break isEscape str
210 in
211 case back of
212 "" ->
213 B.stringUtf8 front
215 char : rest ->
216 B.stringUtf8 front <> escapeChar char <> escape rest
219isEscape :: Char -> Bool
220isEscape c =
221 c == '\"' || c == '\\' || c < '\x20'
224escapeChar :: Char -> B.Builder
225escapeChar char =
226 case char of
227 '\"' -> B.string7 "\\\""
228 '\\' -> B.string7 "\\\\"
229 '\n' -> B.string7 "\\n"
230 '\r' -> B.string7 "\\r"
231 '\t' -> B.string7 "\\t"
232 _ -> if char < '\x20' then toEscapeCode char else B.charUtf8 char
235toEscapeCode :: Char -> B.Builder
236toEscapeCode char =
237 let
238 hex =
239 Numeric.showHex (fromEnum char) ""
241 code =
242 "\\u" ++ replicate (4 - length hex) '0' ++ hex
243 in
244 B.string7 code