Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
reflex-frp
GitHub Repository: reflex-frp/reflex-platform
 Path: blob/develop/haskell-overlays/text-jsstring-8.10/buffer-builder-text-jsstring.patch
1 views
1
From ece29d689b56e51b22b39c8d0b8740e325830f23 Mon Sep 17 00:00:00 2001

2
From: Luigy Leon <[email protected]>

3
Date: Fri, 6 Oct 2017 18:39:35 -0400

4
Subject: [PATCH] text-jsstring

5


6
---

7
 buffer-builder.cabal      |  3 +++

8
 src/Data/BufferBuilder.hs | 25 +++++++++++++++++++++++--

9
 2 files changed, 26 insertions(+), 2 deletions(-)

10


11
diff --git a/buffer-builder.cabal b/buffer-builder.cabal

12
index fe24f73..868d3c1 100644

13
--- a/buffer-builder.cabal

14
+++ b/buffer-builder.cabal

15
@@ -65,6 +65,9 @@ library

16
   if !impl(ghc >= 8.0)

17
     build-depends: semigroups

18
 

19
+  if impl(ghcjs)

20
+    build-depends: ghcjs-base

21
+

22
   default-language: Haskell2010

23
   ghc-options: -O2 -Wall

24
   --ghc-options: -ddump-ds -ddump-simpl -ddump-stg -ddump-opt-cmm -ddump-asm -ddump-to-file

25
diff --git a/src/Data/BufferBuilder.hs b/src/Data/BufferBuilder.hs

26
index 30b39ce..0468afb 100644

27
--- a/src/Data/BufferBuilder.hs

28
+++ b/src/Data/BufferBuilder.hs

29
@@ -1,4 +1,7 @@

30
-{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns, RecordWildCards, DeriveDataTypeable #-}

31
+{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns, RecordWildCards, DeriveDataTypeable, CPP #-}

32
+#ifdef ghcjs_HOST_OS

33
+{-# LANGUAGE UnboxedTuples, ForeignFunctionInterface, UnliftedFFITypes #-}

34
+#endif

35
 

36
 {-|

37
 A library for efficiently building up a buffer of data.  When given data

38
@@ -71,6 +74,9 @@ import Data.Typeable (Typeable)

39
 import Data.Text () -- Show

40
 import Data.Text.Internal (Text (..))

41
 import Data.Text.Array (Array (..))

42
+#ifdef ghcjs_HOST_OS

43
+import Data.JSString

44
+#endif

45
 

46
 data Handle'

47
 type Handle = Ptr Handle'

48
@@ -349,8 +355,17 @@ appendEscapedJsonLiteral addr =

49
 {-# INLINE appendEscapedJsonLiteral #-}

50
 

51
 appendEscapedJsonText :: Text -> BufferBuilder ()

52
+#ifndef ghcjs_HOST_OS

53
 appendEscapedJsonText !(Text arr ofs len) =

54
-    let byteArray = aBA arr

55
+    let

56
+#else

57
+appendEscapedJsonText !(Text t) =

58
+    let (# ba#, len# #) = js_fromString t

59
+        len = I# len#

60
+        arr = Array ba#

61
+        ofs = 0

62
+#endif

63
+        byteArray = aBA arr

64
     in withHandle $ \h ->

65
         bw_append_json_escaped_utf16 h len (Ptr (byteArrayContents# byteArray) `plusPtr` (2 * ofs))

66
 {-# INLINE appendEscapedJsonText #-}

67
@@ -364,3 +379,9 @@ appendUrlEncoded !(BS.PS (ForeignPtr addr _) offset len) =

68
     withHandle $ \h ->

69
         bw_append_url_encoded h len (plusPtr (Ptr addr) offset)

70
 {-# INLINE appendUrlEncoded #-}

71
+

72
+#ifdef ghcjs_HOST_OS

73
+foreign import javascript unsafe

74
+  "h$textFromString"

75
+  js_fromString :: JSString -> (# ByteArray#, Int# #)

76
+#endif

77
-- 

78
2.31.1

79


80


81