3a07bd6 · elk · git.iko.soy

git.iko.soy/elk

Make Json.Encode faster for generating strings

commit3a07bd6e0c20d4a9ccafbd1f628d63973eadb2fa authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 29 Jan 2018, 15:20 (9 years ago) parentdc356df

3 files changed+46−73

compare with master

unifiedsplit

src/Elm/Compiler/Type.hs+8−12 src/Json/Decode/Internals.hs+1−1 src/Json/Encode.hs+37−60

src/Elm/Compiler/Type.hs+8−12

@@ -8,7 +8,6 @@ module Elm.Compiler.Type

88 , Alias(..)

99 , Union(..)

1010 , encode

11− , Error(..)

1211 , decoder

1312 , encodeMetadata

1413 )

@@ -188,15 +187,12 @@ encode tipe =

188187 Encode.text (Text.pack (toString OneLine tipe))

189188

190189

191−data Error = BadType

192−

193−

194−decoder :: Decode.Decoder Error Type

190+decoder :: Decode.Decoder () Type

195191decoder =

196192 do txt <- Decode.text

197193 case Parse.run Type.expression (Text.encodeUtf8 (Text.replace "'" "_" txt)) of

198194 Left _ ->

199− Decode.fail BadType

195+ Decode.fail ()

200196

201197 Right (tipe, _, _) ->

202198 Decode.succeed (fromRawType tipe)

@@ -246,24 +242,24 @@ encodeMetadata (DebugMetadata msg aliases unions) =

246242 ]

247243

248244

249−toAliasField :: Alias -> ( String, Encode.Value )

245+toAliasField :: Alias -> ( Text.Text, Encode.Value )

250246toAliasField (Alias name args tipe) =

251− Text.unpack name ==>

247+ name ==>

252248 Encode.object

253249 [ "args" ==> Encode.list Encode.text args

254250 , "type" ==> encode tipe

255251 ]

256252

257253

258−toUnionField :: Union -> ( String, Encode.Value )

254+toUnionField :: Union -> ( Text.Text, Encode.Value )

259255toUnionField (Union name args constructors) =

260− Text.unpack name ==>

256+ name ==>

261257 Encode.object

262258 [ "args" ==> Encode.list Encode.text args

263259 , "tags" ==> Encode.object (map toCtorObject constructors)

264260 ]

265261

266262

267−toCtorObject :: (Text, [Type]) -> ( String, Encode.Value )

263+toCtorObject :: (Text, [Type]) -> ( Text.Text, Encode.Value )

268264toCtorObject (name, args) =

269− Text.unpack name ==> Encode.list encode args

265+ name ==> Encode.list encode args

src/Json/Decode/Internals.hs+1−1

@@ -261,7 +261,7 @@ toEncodeValue :: Value -> E.Value

261261toEncodeValue value =

262262 case value of

263263 Array vector -> E.array (Vector.toList (Vector.map toEncodeValue vector))

264− Object fields _ -> E.object (fmap (\(k,v) -> (Text.unpack k, toEncodeValue v)) fields)

264+ Object fields _ -> E.object (fmap (fmap toEncodeValue) fields)

265265 String txt -> E.text txt

266266 Integer n -> E.int n

267267 Float n -> E.number n

src/Json/Encode.hs+37−60

@@ -9,7 +9,6 @@ module Json.Encode

99 , array

1010 , object

1111 , text

12− , string

1312 , bool

1413 , int

1514 , number

@@ -25,11 +24,14 @@ import Prelude hiding (null)

2524import Control.Arrow ((***))

2625import qualified Data.ByteString.Char8 as BSC

2726import qualified Data.ByteString.Builder as B

27+import qualified Data.ByteString.Builder.Prim as BP

28+import Data.ByteString.Builder.Prim ((>*<))

2829import qualified Data.Map as Map

2930import qualified Data.Scientific as Sci

3031import Data.Monoid ((<>))

3132import qualified Data.Text as Text

32−import qualified Numeric

33+import qualified Data.Text.Encoding as Text

34+import qualified Data.Word as W

3335import System.IO (IOMode(WriteMode), withBinaryFile)

3436

3537

@@ -39,8 +41,8 @@ import System.IO (IOMode(WriteMode), withBinaryFile)

3941

4042data Value

4143 = Array [Value]

42− | Object [(String, Value)]

43− | String B.Builder

44+ | Object [(Text.Text, Value)]

45+ | String Text.Text

4446 | Boolean Bool

4547 | Integer Int

4648 | Number Sci.Scientific

@@ -52,19 +54,14 @@ array =

5254 Array

5355

5456

55−object :: [(String,Value)] -> Value

57+object :: [(Text.Text,Value)] -> Value

5658object =

5759 Object

5860

5961

6062text :: Text.Text -> Value

61−text txt =

62− String (encodeString (Text.unpack txt))

63−

64−

65−string :: String -> Value

66−string str =

67− String (encodeString str)

63+text =

64+ String

6865

6966

7067bool :: Bool -> Value

@@ -87,7 +84,7 @@ null =

8784 Null

8885

8986

90−dict :: (k -> String) -> (v -> Value) -> Map.Map k v -> Value

87+dict :: (k -> Text.Text) -> (v -> Value) -> Map.Map k v -> Value

9188dict encodeKey encodeValue pairs =

9289 Object $ map (encodeKey *** encodeValue) (Map.toList pairs)

9390

@@ -149,8 +146,8 @@ encodeUgly value =

149146 in

150147 encodeEntry '{' first <> mconcat (map (encodeEntry ',') rest) <> B.char7 '}'

151148

152− String builder ->

153− builder

149+ String txt ->

150+ encodeString txt

154151

155152 Boolean boolean ->

156153 B.string7 (if boolean then "true" else "false")

@@ -189,8 +186,8 @@ encodeHelp indent value =

189186 Object (first : rest) ->

190187 encodeObject indent first rest

191188

192− String builder ->

193− builder

189+ String txt ->

190+ encodeString txt

194191

195192 Boolean boolean ->

196193 B.string7 (if boolean then "true" else "false")

@@ -228,7 +225,7 @@ arrayClose =

228225-- ENCODE OBJECT

229226

230227

231−encodeObject :: BSC.ByteString -> (String, Value) -> [(String, Value)] -> B.Builder

228+encodeObject :: BSC.ByteString -> (Text.Text, Value) -> [(Text.Text, Value)] -> B.Builder

232229encodeObject =

233230 encodeSequence objectOpen objectClose encodeField

234231

@@ -243,7 +240,7 @@ objectClose =

243240 B.char7 '}'

244241

245242

246−encodeField :: BSC.ByteString -> (String, Value) -> B.Builder

243+encodeField :: BSC.ByteString -> (Text.Text, Value) -> B.Builder

247244encodeField indent (key, value) =

248245 encodeString key <> B.string7 ": " <> encodeHelp indent value

249246

@@ -290,48 +287,28 @@ newline =

290287-- ENCODE STRING

291288

292289

293−encodeString :: String -> B.Builder

294−encodeString str =

295− B.char7 '"' <> escape str <> B.char7 '"'

296−

297−

298−escape :: String -> B.Builder

299−escape str =

300− let

301− (front, back) =

302− break isEscape str

303− in

304− case back of

305− "" ->

306− B.stringUtf8 front

307−

308− char : rest ->

309− B.stringUtf8 front <> escapeChar char <> escape rest

290+encodeString :: Text.Text -> B.Builder

291+encodeString txt =

292+ B.char7 '"' <> Text.encodeUtf8BuilderEscaped escapeAscii txt <> B.char7 '"'

310293

311294

312−isEscape :: Char -> Bool

313−isEscape c =

314− c == '\"' || c == '\\' || c < '\x20'

315−

316−

317−escapeChar :: Char -> B.Builder

318−escapeChar char =

319− case char of

320− '\"' -> B.string7 "\\\""

321− '\\' -> B.string7 "\\\\"

322− '\n' -> B.string7 "\\n"

323− '\r' -> B.string7 "\\r"

324− '\t' -> B.string7 "\\t"

325− _ -> if char < '\x20' then toEscapeCode char else B.charUtf8 char

326−

295+{-# INLINE escapeAscii #-}

296+escapeAscii :: BP.BoundedPrim W.Word8

297+escapeAscii =

298+ BP.condB (== 0x5C {- \\ -}) (ascii2 ('\\','\\')) $

299+ BP.condB (== 0x22 {- \" -}) (ascii2 ('\\','"' )) $

300+ BP.condB (>= 0x20 ) (BP.liftFixedToBounded BP.word8) $

301+ BP.condB (== 0x0A {- \n -}) (ascii2 ('\\','n' )) $

302+ BP.condB (== 0x0D {- \r -}) (ascii2 ('\\','r' )) $

303+ BP.condB (== 0x09 {- \t -}) (ascii2 ('\\','t' )) $

304+ BP.liftFixedToBounded hexEscape -- fallback for chars < 0x20

305+ where

306+ hexEscape :: BP.FixedPrim W.Word8

307+ hexEscape = (\c -> ('\\', ('u', fromIntegral c))) BP.>$<

308+ BP.char8 >*< BP.char8 >*< BP.word16HexFixed

327309

328−toEscapeCode :: Char -> B.Builder

329−toEscapeCode char =

330− let

331− hex =

332− Numeric.showHex (fromEnum char) ""

333310

334− code =

335− "\\u" ++ replicate (4 - length hex) '0' ++ hex

336− in

337− B.string7 code

311+{-# INLINE ascii2 #-}

312+ascii2 :: (Char, Char) -> BP.BoundedPrim a

313+ascii2 cs =

314+ BP.liftFixedToBounded $ const cs BP.>$< BP.char7 >*< BP.char7