git.iko.soy/elk
on 08a8971 help sign in
elk/src/Json/Encode.hs
275 lines 4.4 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 , null
14 , dict
15 , list
16 , (==>)
17 )
18 where
21import Prelude hiding (null)
22import Control.Arrow ((***))
23import qualified Data.ByteString.Char8 as BSC
24import qualified Data.ByteString.Builder as B
25import qualified Data.Map as Map
26import Data.Monoid ((<>))
27import qualified Data.Text as Text
28import qualified Numeric
29import System.IO (IOMode(WriteMode), withBinaryFile)
33-- VALUES
36data Value
37 = Array [Value]
38 | Object [(String, Value)]
39 | String B.Builder
40 | Boolean Bool
41 | Integer Int
42 | Null
45array :: [Value] -> Value
46array =
47 Array
50object :: [(String,Value)] -> Value
51object =
52 Object
55text :: Text.Text -> Value
56text txt =
57 String (encodeString (Text.unpack txt))
60string :: String -> Value
61string str =
62 String (encodeString str)
65bool :: Bool -> Value
66bool =
67 Boolean
70int :: Int -> Value
71int =
72 Integer
75null :: Value
76null =
77 Null
80dict :: (k -> String) -> (v -> Value) -> Map.Map k v -> Value
81dict encodeKey encodeValue pairs =
82 Object $ map (encodeKey *** encodeValue) (Map.toList pairs)
85list :: (a -> Value) -> [a] -> Value
86list encodeEntry entries =
87 Array $ map encodeEntry entries
91-- HELPERS
94(==>) :: a -> b -> (a, b)
95(==>) a b =
96 (a, b)
100-- WRITE TO FILE
103write :: FilePath -> Value -> IO ()
104write path value =
105 withBinaryFile path WriteMode $ \handle ->
106 B.hPutBuilder handle (encode value)
110-- ENCODE
113encode :: Value -> B.Builder
114encode value =
115 encodeHelp "" value
118encodeHelp :: BSC.ByteString -> Value -> B.Builder
119encodeHelp indent value =
120 case value of
121 Array [] ->
122 B.string7 "[]"
124 Array (first : rest) ->
125 encodeArray indent first rest
127 Object [] ->
128 B.string7 "{}"
130 Object (first : rest) ->
131 encodeObject indent first rest
133 String builder ->
134 builder
136 Boolean boolean ->
137 B.string7 (if boolean then "true" else "false")
139 Integer n ->
140 B.intDec n
142 Null ->
143 "null"
147-- ENCODE ARRAY
150encodeArray :: BSC.ByteString -> Value -> [Value] -> B.Builder
151encodeArray =
152 encodeSequence arrayOpen arrayClose encodeHelp
155arrayOpen :: B.Builder
156arrayOpen =
157 B.string7 "[\n"
160arrayClose :: B.Builder
161arrayClose =
162 B.char7 ']'
166-- ENCODE OBJECT
169encodeObject :: BSC.ByteString -> (String, Value) -> [(String, Value)] -> B.Builder
170encodeObject =
171 encodeSequence objectOpen objectClose encodeField
174objectOpen :: B.Builder
175objectOpen =
176 B.string7 "{\n"
179objectClose :: B.Builder
180objectClose =
181 B.char7 '}'
184encodeField :: BSC.ByteString -> (String, Value) -> B.Builder
185encodeField indent (key, value) =
186 encodeString key <> B.string7 ": " <> encodeHelp indent value
190-- ENCODE SEQUENCE
193encodeSequence :: B.Builder -> B.Builder -> (BSC.ByteString -> a -> B.Builder) -> BSC.ByteString -> a -> [a] -> B.Builder
194encodeSequence open close encodeEntry indent first rest =
195 let
196 newIndent =
197 indent <> "\t"
199 newIndentBuilder =
200 B.byteString newIndent
202 closer =
203 newline <> B.byteString indent <> close
205 addValue field builder =
206 commaNewline
207 <> newIndentBuilder
208 <> encodeEntry newIndent field
209 <> builder
210 in
211 open
212 <> newIndentBuilder
213 <> encodeEntry newIndent first
214 <> foldr addValue closer rest
217commaNewline :: B.Builder
218commaNewline =
219 B.string7 ",\n"
222newline :: B.Builder
223newline =
224 B.char7 '\n'
228-- ENCODE STRING
231encodeString :: String -> B.Builder
232encodeString str =
233 B.char7 '"' <> escape str <> B.char7 '"'
236escape :: String -> B.Builder
237escape str =
238 let
239 (front, back) =
240 break isEscape str
241 in
242 case back of
243 "" ->
244 B.stringUtf8 front
246 char : rest ->
247 B.stringUtf8 front <> escapeChar char <> escape rest
250isEscape :: Char -> Bool
251isEscape c =
252 c == '\"' || c == '\\' || c < '\x20'
255escapeChar :: Char -> B.Builder
256escapeChar char =
257 case char of
258 '\"' -> B.string7 "\\\""
259 '\\' -> B.string7 "\\\\"
260 '\n' -> B.string7 "\\n"
261 '\r' -> B.string7 "\\r"
262 '\t' -> B.string7 "\\t"
263 _ -> if char < '\x20' then toEscapeCode char else B.charUtf8 char
266toEscapeCode :: Char -> B.Builder
267toEscapeCode char =
268 let
269 hex =
270 Numeric.showHex (fromEnum char) ""
272 code =
273 "\\u" ++ replicate (4 - length hex) '0' ++ hex
274 in
275 B.string7 code