git.iko.soy/elk
on 441aeba help sign in
elk/src/Json/Encode.hs
264 lines 4.3 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 , int
13 , dict
14 , list
15 , (==>)
16 )
17 where
20import Control.Arrow ((***))
21import qualified Data.ByteString.Char8 as BSC
22import qualified Data.ByteString.Builder as B
23import qualified Data.Map as Map
24import Data.Monoid ((<>))
25import qualified Data.Text as Text
26import qualified Numeric
27import System.IO (IOMode(WriteMode), withBinaryFile)
31-- VALUES
34data Value
35 = Array [Value]
36 | Object [(String, Value)]
37 | String B.Builder
38 | Boolean Bool
39 | Integer Int
42array :: [Value] -> Value
43array =
44 Array
47object :: [(String,Value)] -> Value
48object =
49 Object
52text :: Text.Text -> Value
53text txt =
54 String (encodeString (Text.unpack txt))
57string :: String -> Value
58string str =
59 String (encodeString str)
62bool :: Bool -> Value
63bool =
64 Boolean
67int :: Int -> Value
68int =
69 Integer
72dict :: (k -> String) -> (v -> Value) -> Map.Map k v -> Value
73dict encodeKey encodeValue pairs =
74 Object $ map (encodeKey *** encodeValue) (Map.toList pairs)
77list :: (a -> Value) -> [a] -> Value
78list encodeEntry entries =
79 Array $ map encodeEntry entries
83-- HELPERS
86(==>) :: a -> b -> (a, b)
87(==>) a b =
88 (a, b)
92-- WRITE TO FILE
95write :: FilePath -> Value -> IO ()
96write path value =
97 withBinaryFile path WriteMode $ \handle ->
98 B.hPutBuilder handle (encode value)
102-- ENCODE
105encode :: Value -> B.Builder
106encode value =
107 encodeHelp "" value
110encodeHelp :: BSC.ByteString -> Value -> B.Builder
111encodeHelp indent value =
112 case value of
113 Array [] ->
114 B.string7 "[]"
116 Array (first : rest) ->
117 encodeArray indent first rest
119 Object [] ->
120 B.string7 "{}"
122 Object (first : rest) ->
123 encodeObject indent first rest
125 String builder ->
126 builder
128 Boolean boolean ->
129 B.string7 (if boolean then "true" else "false")
131 Integer n ->
132 B.intDec n
136-- ENCODE ARRAY
139encodeArray :: BSC.ByteString -> Value -> [Value] -> B.Builder
140encodeArray =
141 encodeSequence arrayOpen arrayClose encodeHelp
144arrayOpen :: B.Builder
145arrayOpen =
146 B.string7 "[\n"
149arrayClose :: B.Builder
150arrayClose =
151 B.char7 ']'
155-- ENCODE OBJECT
158encodeObject :: BSC.ByteString -> (String, Value) -> [(String, Value)] -> B.Builder
159encodeObject =
160 encodeSequence objectOpen objectClose encodeField
163objectOpen :: B.Builder
164objectOpen =
165 B.string7 "{\n"
168objectClose :: B.Builder
169objectClose =
170 B.char7 '}'
173encodeField :: BSC.ByteString -> (String, Value) -> B.Builder
174encodeField indent (key, value) =
175 encodeString key <> B.string7 ": " <> encodeHelp indent value
179-- ENCODE SEQUENCE
182encodeSequence :: B.Builder -> B.Builder -> (BSC.ByteString -> a -> B.Builder) -> BSC.ByteString -> a -> [a] -> B.Builder
183encodeSequence open close encodeEntry indent first rest =
184 let
185 newIndent =
186 indent <> "\t"
188 newIndentBuilder =
189 B.byteString newIndent
191 closer =
192 newline <> B.byteString indent <> close
194 addValue field builder =
195 builder
196 <> commaNewline
197 <> newIndentBuilder
198 <> encodeEntry newIndent field
199 in
200 open
201 <> newIndentBuilder
202 <> encodeEntry newIndent first
203 <> foldr addValue closer rest
206commaNewline :: B.Builder
207commaNewline =
208 B.string7 ",\n"
211newline :: B.Builder
212newline =
213 B.char7 '\n'
217-- ENCODE STRING
220encodeString :: String -> B.Builder
221encodeString str =
222 B.char7 '"' <> escape str <> B.char7 '"'
225escape :: String -> B.Builder
226escape str =
227 let
228 (front, back) =
229 break isEscape str
230 in
231 case back of
232 "" ->
233 B.stringUtf8 front
235 char : rest ->
236 B.stringUtf8 front <> escapeChar char <> escape rest
239isEscape :: Char -> Bool
240isEscape c =
241 c == '\"' || c == '\\' || c < '\x20'
244escapeChar :: Char -> B.Builder
245escapeChar char =
246 case char of
247 '\"' -> B.string7 "\\\""
248 '\\' -> B.string7 "\\\\"
249 '\n' -> B.string7 "\\n"
250 '\r' -> B.string7 "\\r"
251 '\t' -> B.string7 "\\t"
252 _ -> if char < '\x20' then toEscapeCode char else B.charUtf8 char
255toEscapeCode :: Char -> B.Builder
256toEscapeCode char =
257 let
258 hex =
259 Numeric.showHex (fromEnum char) ""
261 code =
262 "\\u" ++ replicate (4 - length hex) '0' ++ hex
263 in
264 B.string7 code