3a07bd6 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Make Json.Encode faster for generating strings

3a07bd6Evan Czaplicki9 years ago

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

compare with master

unifiedsplit

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

8 , Alias(..)

9 , Union(..)

10 , encode

11− , Error(..)

12 , decoder

11 , decoder

13 , encodeMetadata

12 , encodeMetadata

14 )

13 )

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

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

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

189

188

190

189

191−data Error = BadType

192−

193−

194−decoder :: Decode.Decoder Error Type

190+decoder :: Decode.Decoder () Type

195decoder =

191decoder =

196 do txt <- Decode.text

192 do txt <- Decode.text

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

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

198 Left _ ->

194 Left _ ->

199− Decode.fail BadType

195+ Decode.fail ()

200

196

201 Right (tipe, _, _) ->

197 Right (tipe, _, _) ->

202 Decode.succeed (fromRawType tipe)

198 Decode.succeed (fromRawType tipe)

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

246 ]

242 ]

247

243

248

244

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

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

250toAliasField (Alias name args tipe) =

246toAliasField (Alias name args tipe) =

251− Text.unpack name ==>

247+ name ==>

252 Encode.object

248 Encode.object

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

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

254 , "type" ==> encode tipe

250 , "type" ==> encode tipe

255 ]

251 ]

256

252

257

253

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

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

259toUnionField (Union name args constructors) =

255toUnionField (Union name args constructors) =

260− Text.unpack name ==>

256+ name ==>

261 Encode.object

257 Encode.object

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

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

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

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

264 ]

260 ]

265

261

266

262

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

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

268toCtorObject (name, args) =

264toCtorObject (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

261toEncodeValue value =

262 case value of

263 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)

265 String txt -> E.text txt

266 Integer n -> E.int n

267 Float n -> E.number n

src/Json/Encode.hs+37−60

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

9 , array

10 , object

11 , text

12− , string

13 , bool

12 , bool

14 , int

13 , int

15 , number

14 , number

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

25import Control.Arrow ((***))

24import Control.Arrow ((***))

26import qualified Data.ByteString.Char8 as BSC

25import qualified Data.ByteString.Char8 as BSC

27import qualified Data.ByteString.Builder as B

26import qualified Data.ByteString.Builder as B

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

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

28import qualified Data.Map as Map

29import qualified Data.Map as Map

29import qualified Data.Scientific as Sci

30import qualified Data.Scientific as Sci

30import Data.Monoid ((<>))

31import Data.Monoid ((<>))

31import qualified Data.Text as Text

32import qualified Data.Text as Text

32−import qualified Numeric

33+import qualified Data.Text.Encoding as Text

34+import qualified Data.Word as W

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

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

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

40data Value

42data Value

41 = Array [Value]

43 = Array [Value]

42− | Object [(String, Value)]

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

43− | String B.Builder

45+ | String Text.Text

44 | Boolean Bool

46 | Boolean Bool

45 | Integer Int

47 | Integer Int

46 | Number Sci.Scientific

48 | Number Sci.Scientific

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

52 Array

54 Array

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

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

56object =

58object =

57 Object

59 Object

60text :: Text.Text -> Value

62text :: Text.Text -> Value

61−text txt =

63+text =

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

64+ String

63−

64−

65−string :: String -> Value

66−string str =

67− String (encodeString str)

70bool :: Bool -> Value

67bool :: Bool -> Value

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

87 Null

84 Null

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

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

91dict encodeKey encodeValue pairs =

88dict encodeKey encodeValue pairs =

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

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

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

149 in

146 in

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

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

151

148

152− String builder ->

149+ String txt ->

153− builder

150+ encodeString txt

154

151

155 Boolean boolean ->

152 Boolean boolean ->

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

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

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

189 Object (first : rest) ->

186 Object (first : rest) ->

190 encodeObject indent first rest

187 encodeObject indent first rest

191

188

192− String builder ->

189+ String txt ->

193− builder

190+ encodeString txt

194

191

195 Boolean boolean ->

192 Boolean boolean ->

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

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

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

228-- ENCODE OBJECT

225-- ENCODE OBJECT

229

226

230

227

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

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

232encodeObject =

229encodeObject =

233 encodeSequence objectOpen objectClose encodeField

230 encodeSequence objectOpen objectClose encodeField

234

231

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

243 B.char7 '}'

240 B.char7 '}'

244

241

245

242

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

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

247encodeField indent (key, value) =

244encodeField indent (key, value) =

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

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

249

246

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

290-- ENCODE STRING

287-- ENCODE STRING

291

288

292

289

293−encodeString :: String -> B.Builder

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

294−encodeString str =

291+encodeString txt =

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

292+ B.char7 '"' <> Text.encodeUtf8BuilderEscaped escapeAscii txt <> 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

310

293

311

294

312−isEscape :: Char -> Bool

295+{-# INLINE escapeAscii #-}

313−isEscape c =

296+escapeAscii :: BP.BoundedPrim W.Word8

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

297+escapeAscii =

315−

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

316−

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

317−escapeChar :: Char -> B.Builder

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

318−escapeChar char =

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

319− case char of

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

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

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

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

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

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

305+ where

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

306+ hexEscape :: BP.FixedPrim W.Word8

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

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

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

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

326−

327

309

328−toEscapeCode :: Char -> B.Builder

329−toEscapeCode char =

330− let

331− hex =

332− Numeric.showHex (fromEnum char) ""

333

310

334− code =

311+{-# INLINE ascii2 #-}

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

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

336− in

313+ascii2 cs =

337− B.string7 code

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