blank-canvas 0.7.1 → 0.7.2
raw patch · 3 files changed
+41/−33 lines, 3 filesdep ~wai-extraPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: wai-extra
API changes (from Hackage documentation)
Files
- Changelog.md +4/−1
- Graphics/Blank/JavaScript.hs +31/−27
- blank-canvas.cabal +6/−5
Changelog.md view
@@ -1,4 +1,7 @@-## 0.7.1+### 0.7.2+* Render Unicode codepoints beyond `0xFFFF` properly.++### 0.7.1 * Remove the `wiki-suite` test suite from `blank-canvas.cabal`, as it was never intended to work as a traditional test suite. The functionality of `wiki-suite` has moved to a subdirectory of the upstream `blank-canvas`
Graphics/Blank/JavaScript.hs view
@@ -1,35 +1,38 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-} module Graphics.Blank.JavaScript where -import Data.Char (isControl, isAscii, ord)+import Data.Bits (shiftR, (.&.))+import Data.Char (isAscii, isControl, ord) import Data.Colour import Data.Colour.SRGB import Data.Default.Class import Data.Ix-import Data.List+import Data.List hiding (length) import Data.String-import Data.Text (Text)-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as B (singleton)-import qualified Data.Vector.Unboxed as V-import Data.Vector.Unboxed (Vector, toList)-import Data.Word (Word8)+import Data.Text (Text)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as B (singleton)+import Data.Vector.Unboxed (Vector, toList)+import qualified Data.Vector.Unboxed as V+import Data.Word (Word8) import Graphics.Blank.Parser import Prelude.Compat -import Text.ParserCombinators.ReadP (choice, skipSpaces)+import Text.ParserCombinators.ReadP (choice, skipSpaces) import Text.ParserCombinators.ReadPrec (lift)-import Text.Read (Read(..), parens, readListPrecDefault)+import Text.Read (Read (..), parens,+ readListPrecDefault) +import Numeric (showHex) import TextShow-import TextShow.Data.Floating (showbFFloat)-import TextShow.Data.Integral (showbHex)-import TextShow.TH (deriveTextShow)+import TextShow.Data.Floating (showbFFloat)+import TextShow.Data.Integral (showbHex)+import TextShow.TH (deriveTextShow) ------------------------------------------------------------- @@ -543,13 +546,6 @@ jsQuoteBuilder :: Builder -> Builder jsQuoteBuilder b = B.singleton '"' <> b <> B.singleton '"' --- | Transform a character to a lazy 'TL.Text' that represents its JS--- unicode escape sequence.-jsUnicodeChar :: Char -> TL.Text-jsUnicodeChar c =- let hex = toLazyText . showbHex $ ord c- in "\\u" <> TL.replicate (4 - TL.length hex) (TL.singleton '0') <> hex- -- | Correctly replace a `Builder'`s characters by the JS escape sequences. jsEscapeBuilder :: Builder -> Builder jsEscapeBuilder = fromLazyText . TL.concatMap jsEscapeChar . toLazyText@@ -558,8 +554,6 @@ jsEscapeChar :: Char -> TL.Text jsEscapeChar '\\' = "\\\\" -- Special control sequences.-jsEscapeChar '\0' = jsUnicodeChar '\0' -- Ambigous with numbers-jsEscapeChar '\a' = jsUnicodeChar '\a' -- Non JS jsEscapeChar '\b' = "\\b" jsEscapeChar '\f' = "\\f" jsEscapeChar '\n' = "\\n"@@ -568,7 +562,17 @@ jsEscapeChar '\v' = "\\v" jsEscapeChar '\"' = "\\\"" jsEscapeChar '\'' = "\\'"--- Non-control ASCII characters can remain as they are.-jsEscapeChar c' | not (isControl c') && isAscii c' = TL.singleton c'--- All other non ASCII signs are escaped to unicode.-jsEscapeChar c' = jsUnicodeChar c'+-- Code borrowed from GHCJS implementation: https://github.com/ghcjs/ghcjs/blob/718b37fc7167269ebca633914c716c3dbe6d0faf/src/Compiler/JMacro/Base.hs#L887-L905+jsEscapeChar '/' = "\\/"+jsEscapeChar c+ -- Non-control ASCII characters can remain as they are.+ | not (isControl c) && isAscii c = TL.singleton c+ | ord c <= 0xff = hexxs "\\x" 2 (ord c)+ -- All other non ASCII signs are escaped to unicode.+ | ord c <= 0xffff = hexxs "\\u" 4 (ord c)+ | otherwise = let cp0 = ord c - 0x10000 -- output surrogate pair+ in hexxs "\\u" 4 ((cp0 `shiftR` 10) + 0xd800) `mappend`+ hexxs "\\u" 4 ((cp0 .&. 0x3ff) + 0xdc00)+ where hexxs prefix pad cp =+ let h = showHex cp ""+ in TL.pack (prefix ++ replicate (pad - length h) '0' ++ h)
blank-canvas.cabal view
@@ -1,5 +1,5 @@ Name: blank-canvas-Version: 0.7.1+Version: 0.7.2 Synopsis: HTML5 Canvas Graphics Library Description: @blank-canvas@ is a Haskell binding to the complete@@ -47,7 +47,8 @@ , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5- , GHC == 8.8.1+ , GHC == 8.8.3+ , GHC == 8.10.1 data-files: static/index.html static/jquery.js@@ -74,8 +75,8 @@ Paths_blank_canvas default-language: Haskell2010- build-depends: aeson >= 0.7 && < 1.5,- base64-bytestring == 1.0.*,+ build-depends: aeson >= 0.7 && < 1.6,+ base64-bytestring >= 1.0 && < 1.3, base >= 4.7 && < 4.15, base-compat-batteries >= 0.10 && < 0.12, bytestring == 0.10.*,@@ -86,7 +87,7 @@ http-types >= 0.8 && < 0.13, mime-types >= 0.1.0.3 && < 0.2, kansas-comet >= 0.4 && < 0.5,- scotty >= 0.10 && < 0.12,+ scotty >= 0.10 && < 0.13, semigroups >= 0.18 && < 1, stm >= 2.2 && < 2.6, text >= 1.1 && < 1.3,