jsaddle 0.7.0.0 → 0.8.0.0

raw patch · 44 files changed

+4554/−603 lines, 44 filesdep +base64-bytestringdep −template-haskellPVP ok

version bump matches the API change (PVP)

Dependencies added: base64-bytestring

Dependencies removed: template-haskell

API changes (from Hackage documentation)

Files

• jsaddle.cabal +29/−4
• src-ghc/Data/JSString.hs +1404/−0
• src-ghc/Data/JSString/Internal.hs +1/−0
• src-ghc/Data/JSString/Internal/Fusion.hs +127/−0
• src-ghc/Data/JSString/Internal/Fusion/CaseMapping.hs +570/−0
• src-ghc/Data/JSString/Internal/Fusion/Common.hs +92/−0
• src-ghc/Data/JSString/Internal/Fusion/Types.hs +122/−0
• src-ghc/Data/JSString/Internal/Search.hs +11/−0
• src-ghc/Data/JSString/Internal/Type.hs +115/−0
• src-ghc/Data/JSString/Text.hs +52/−0
• src-ghc/GHCJS/Buffer.hs +117/−0
• src-ghc/GHCJS/Buffer/Types.hs +11/−0
• src-ghc/GHCJS/Foreign.hs +64/−0
• src-ghc/GHCJS/Foreign/Internal.hs +65/−0
• src-ghc/GHCJS/Internal/Types.hs +16/−0
• src-ghc/GHCJS/Marshal.hs +37/−36
• src-ghc/GHCJS/Marshal/Internal.hs +45/−30
• src-ghc/GHCJS/Marshal/Pure.hs +5/−6
• src-ghc/GHCJS/Prim.hs +84/−0
• src-ghc/GHCJS/Prim/Internal.hs +66/−0
• src-ghc/GHCJS/Types.hs +58/−0
• src-ghc/JavaScript/Array.hs +134/−0
• src-ghc/JavaScript/Array/Internal.hs +33/−18
• src-ghc/JavaScript/Object.hs +10/−0
• src-ghc/JavaScript/Object/Internal.hs +26/−22
• src-ghc/JavaScript/TypedArray.hs +19/−0
• src-ghc/JavaScript/TypedArray/ArrayBuffer.hs +51/−0
• src-ghc/JavaScript/TypedArray/ArrayBuffer/Internal.hs +33/−0
• src-ghc/JavaScript/TypedArray/ArrayBuffer/Type.hs +6/−0
• src-ghc/JavaScript/TypedArray/DataView/Internal.hs +147/−0
• src-ghc/JavaScript/TypedArray/Immutable.hs +1/−0
• src-ghc/JavaScript/TypedArray/Internal.hs +344/−0
• src-ghc/JavaScript/TypedArray/Internal/Types.hs +121/−0
• src/Language/Javascript/JSaddle/Array.hs +0/−121
• src/Language/Javascript/JSaddle/Evaluate.hs +2/−6
• src/Language/Javascript/JSaddle/Exception.hs +6/−1
• src/Language/Javascript/JSaddle/Foreign.hs +0/−99
• src/Language/Javascript/JSaddle/Native.hs +1/−6
• src/Language/Javascript/JSaddle/Native/Internal.hs +180/−15
• src/Language/Javascript/JSaddle/Object.hs +5/−12
• src/Language/Javascript/JSaddle/Run.hs +60/−40
• src/Language/Javascript/JSaddle/Run/Files.hs +132/−72
• src/Language/Javascript/JSaddle/Types.hs +95/−27
• src/Language/Javascript/JSaddle/Value.hs +57/−88

@@ -1,5 +1,5 @@ name: jsaddle-version: 0.7.0.0+version: 0.8.0.0 cabal-version: >=1.10 build-type: Simple license: MIT@@ -40,23 +40,48 @@             unordered-containers >=0.2 && <0.3,             vector >=0.10 && <0.12         exposed-modules:+            Data.JSString+            Data.JSString.Internal+            Data.JSString.Internal.Fusion+            Data.JSString.Internal.Fusion.CaseMapping+            Data.JSString.Internal.Fusion.Common+            Data.JSString.Internal.Fusion.Types+            Data.JSString.Internal.Search+            Data.JSString.Internal.Type+            Data.JSString.Text+            GHCJS.Prim+            GHCJS.Prim.Internal+            GHCJS.Types+            GHCJS.Foreign+            GHCJS.Foreign.Internal+            GHCJS.Internal.Types             GHCJS.Marshal             GHCJS.Marshal.Internal             GHCJS.Marshal.Pure+            GHCJS.Buffer+            GHCJS.Buffer.Types+            JavaScript.TypedArray+            JavaScript.TypedArray.ArrayBuffer+            JavaScript.TypedArray.ArrayBuffer.Internal+            JavaScript.TypedArray.ArrayBuffer.Type+            JavaScript.TypedArray.DataView.Internal+            JavaScript.TypedArray.Immutable+            JavaScript.TypedArray.Internal+            JavaScript.TypedArray.Internal.Types+            JavaScript.Array             JavaScript.Array.Internal+            JavaScript.Object             JavaScript.Object.Internal             Language.Javascript.JSaddle.Native             Language.Javascript.JSaddle.Native.Internal         hs-source-dirs: src-ghc     exposed-modules:         Language.Javascript.JSaddle-        Language.Javascript.JSaddle.Array         Language.Javascript.JSaddle.Arguments         Language.Javascript.JSaddle.Classes         Language.Javascript.JSaddle.Classes.Internal         Language.Javascript.JSaddle.Evaluate         Language.Javascript.JSaddle.Exception-        Language.Javascript.JSaddle.Foreign         Language.Javascript.JSaddle.Marshal.String         Language.Javascript.JSaddle.Monad         Language.Javascript.JSaddle.Object@@ -69,10 +94,10 @@     build-depends:         aeson >=0.8.0.2 && <1.1,         base <5,+        base64-bytestring >=1.0.0.1 && <1.1,         bytestring >=0.10.6.0 && <0.11,         lens >=3.8.5 && <4.16,         primitive >=0.6.1.0 && <0.7,-        template-haskell -any,         text >=1.2.1.3 && <1.3,         transformers >=0.4.2.0 && <0.6     default-language: Haskell2010

@@ -0,0 +1,1404 @@+{-# LANGUAGE MagicHash, BangPatterns, UnboxedTuples, TypeFamilies+  #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-| Manipulation of JavaScript strings, API and fusion implementation+    based on Data.Text by Tom Harper, Duncan Coutts, Bryan O'Sullivan e.a.+ -}+module Data.JSString ( JSString++                       -- * Creation and elimination+                     , pack+                     , unpack, unpack'+                     , singleton+                     , empty++                       -- * Basic interface+                     , cons+                     , snoc+                     , append+                     , uncons+                     , head+                     , last+                     , tail+                     , init+                     , null+                     , length+                     , compareLength++                       -- * Transformations+                     , map+                     , intercalate+                     , intersperse+                     , transpose+                     , reverse+                     , replace++                       -- ** Case conversion+                     , toCaseFold+                     , toLower+                     , toUpper+                     , toTitle++                       -- ** Justification+                     , justifyLeft+                     , justifyRight+                     , center++                       -- * Folds+                     , foldl+                     , foldl'+                     , foldl1+                     , foldl1'+                     , foldr+                     , foldr1++                       -- ** Special folds+                     , concat+                     , concatMap+                     , any+                     , all+                     , maximum+                     , minimum++                       -- * Construction++                       -- ** Scans+                     , scanl+                     , scanl1+                     , scanr+                     , scanr1++                       -- ** Accumulating maps+                     , mapAccumL+                     , mapAccumR++                       -- ** Generation and unfolding+                     , replicate+                     , unfoldr+                     , unfoldrN++                       -- * Substrings++                       -- ** Breaking strings+                     , take+                     , takeEnd+                     , drop+                     , dropEnd+                     , takeWhile+                     , dropWhile+                     , dropWhileEnd+                     , dropAround+                     , strip+                     , stripStart+                     , stripEnd+                     , splitAt+                     , breakOn+                     , breakOnEnd+                     , break+                     , span+                     , group+                     , group'+                     , groupBy+                     , inits+                     , tails++                       -- ** Breaking into many substrings+                     , splitOn, splitOn'+                     , split+                     , chunksOf, chunksOf'++                       -- ** Breaking into lines and words+                     , lines, lines'+                     , words, words'+                     , unlines+                     , unwords++                       -- * Predicates+                     , isPrefixOf+                     , isSuffixOf+                     , isInfixOf++                       -- ** View patterns+                     , stripPrefix+                     , stripSuffix+                     , commonPrefixes++                       -- * Searching+                     , filter+                     , breakOnAll, breakOnAll'+                     , find+                     , partition++                       -- * Indexing+                     , index+                     , findIndex+                     , count++                       -- * Zipping+                     , zip+                     , zipWith+                     ) where++import           Prelude+  ( Char, Bool(..), Int, Maybe(..), String, Eq(..), Ord(..), Ordering(..), (++)+  , Read(..), Show(..), (&&), (||), (+), (-), (.), ($), ($!), (>>)+  , not, seq, return, otherwise, quot)+import qualified Prelude                              as P++import           Control.DeepSeq                      (NFData(..))+import           Data.Char                            (isSpace)+import           Data.Coerce                          (coerce)+import qualified Data.List                            as L+import           Data.Data+import qualified Data.Text                            as T+import qualified Data.Text.Internal.Fusion            as TF+import qualified Data.Text.Internal.Fusion.Common     as TF++import           GHC.Exts+  ( Int#, (+#), (-#), (>=#), (>#), isTrue#, chr#, Char(..)+  , Int(..), Addr#, tagToEnum#)+import qualified GHC.Exts                             as Exts+import qualified GHC.CString                          as GHC++import           Unsafe.Coerce++import           GHCJS.Prim                           (JSVal)++import           Data.JSString.Internal.Type+import           Data.JSString.Internal.Fusion        (stream, unstream)+import qualified Data.JSString.Internal.Fusion        as S+import qualified Data.JSString.Internal.Fusion.Common as S++instance Exts.IsList JSString where+  type Item JSString = Char+  fromList           = pack+  toList             = unpack++-- -----------------------------------------------------------------------------+-- * Conversion to/from 'JSString'++-- | /O(n)/ Convert a 'String' into a 'JSString'.  Subject to+-- fusion.+pack :: String -> JSString+pack = coerce T.pack+{-# INLINE [1] pack #-}++{-# RULES+"JSSTRING pack -> fused" [~1] forall x.+    pack x = unstream (S.map safe (S.streamList x))+"JSSTRING pack -> unfused" [1] forall x.+    unstream (S.map safe (S.streamList x)) = pack x+  #-}++-- | /O(n)/ Convert a 'JSString' into a 'String'.  Subject to fusion.+unpack :: JSString -> String+unpack = S.unstreamList . stream+{-# INLINE [1] unpack #-}++unpack' :: JSString -> String+unpack' = coerce T.unpack+{-# INLINE unpack' #-}++-- | /O(n)/ Convert a literal string into a JSString.  Subject to fusion.+unpackCString# :: Addr# -> JSString+unpackCString# = coerce T.unpackCString#+{-# NOINLINE unpackCString# #-}++{-# RULES "JSSTRING literal" forall a.+    unstream (S.map safe (S.streamList (GHC.unpackCString# a)))+      = unpackCString# a #-}++{-# RULES "JSSTRING literal UTF8" forall a.+    unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))+      = unpackCString# a #-}++{-# RULES "JSSTRING empty literal"+    unstream (S.map safe (S.streamList []))+      = empty_ #-}++{-# RULES "JSSTRING singleton literal" forall a.+    unstream (S.map safe (S.streamList [a]))+      = singleton a #-}+++-- | /O(1)/ Convert a character into a 'JSString'.  Subject to fusion.+-- Performs replacement on invalid scalar values.+singleton :: Char -> JSString+singleton = coerce T.singleton+{-# INLINE [1] singleton #-}++{-# RULES+"JSSTRING singleton -> fused" [~1] forall a.+    singleton a = unstream (S.singleton (safe a))+"JSSTRING singleton -> unfused" [1] forall a.+    unstream (S.singleton (safe a)) = singleton a+ #-}++-- This is intended to reduce inlining bloat.+-- singleton_ :: Char -> Text+-- singleton_ c = js_singleton c++-- Text (A.run x) 0 len+--  where x :: ST s (A.MArray s)+--        x = do arr <- A.new len+--               _ <- unsafeWrite arr 0 d+--               return arr+--        len | d < '\x10000' = 1+-- x           | otherwise     = 2+--        d = safe c+-- {-# NOINLINE singleton_ #-}++-- -----------------------------------------------------------------------------+-- * Basic functions++-- | /O(n)/ Adds a character to the front of a 'JSString'.  This function+-- is more costly than its 'List' counterpart because it requires+-- copying a new array.  Subject to fusion.  Performs replacement on+-- invalid scalar values.+cons :: Char -> JSString -> JSString+cons = coerce T.cons+{-# INLINE [1] cons #-}++{-# RULES+"JSSTRING cons -> fused" [~1] forall c x.+    cons c x = unstream (S.cons (safe c) (stream x))+"JSSTRING cons -> unfused" [1] forall c x.+    unstream (S.cons (safe c) (stream x)) = cons c x+ #-}++infixr 5 `cons`++-- | /O(n)/ Adds a character to the end of a 'JSString'.  This copies the+-- entire array in the process, unless fused.  Subject to fusion.+-- Performs replacement on invalid scalar values.+snoc :: JSString -> Char -> JSString+snoc = coerce T.snoc+  -- unstream (S.snoc (stream t) (safe c))+{-# INLINE [1] snoc #-}++{-# RULES+"JSSTRING snoc -> fused" [~1] forall x c.+    snoc x c = unstream (S.snoc (stream x) (safe c))+"JSSTRING snoc -> unfused" [1] forall x c.+    unstream (S.snoc (stream x) (safe c)) = snoc x c+ #-}++-- | /O(n)/ Appends one 'JSString' to the other by copying both of them+-- into a new 'JSString'.  Subject to fusion.+append :: JSString -> JSString -> JSString+append = coerce T.append+{-# INLINE [1] append #-}++{-# RULES+"JSSTRING append -> fused" [~1] forall x1 x2.+    append x1 x2 = unstream (S.append (stream x1) (stream x2))+"JSSTRING append -> unfused" [1] forall x1 x2.+    unstream (S.append (stream x1) (stream x2)) = append x1 x2+ #-}++-- | /O(1)/ Returns the first character of a 'JSString', which must be+-- non-empty.  Subject to fusion.+head :: JSString -> Char+head = coerce T.head+{-# INLINE [1] head #-}++{-# RULES+"JSSTRING head -> fused" [~1] forall x.+    head x = S.head (stream x)+"JSSTRING head -> unfused" [1] forall x.+    S.head (stream x) = head x+ #-}+++-- | /O(1)/ Returns the first character and rest of a 'JSString', or+-- 'Nothing' if empty. Subject to fusion.+uncons :: JSString -> Maybe (Char, JSString)+uncons = coerce T.uncons+{-# INLINE [1] uncons #-}++-- | Lifted from Control.Arrow and specialized.+second :: (b -> c) -> (a,b) -> (a,c)+second f (a, b) = (a, f b)++-- | /O(1)/ Returns the last character of a 'JSString', which must be+-- non-empty.  Subject to fusion.+last :: JSString -> Char+last = coerce T.last+{-# INLINE [1] last #-}++{-# RULES+"JSSTRING last -> fused" [~1] forall x.+    last x = S.last (stream x)+"JSSTRING last -> unfused" [1] forall x.+    S.last (stream x) = last x+  #-}++-- | /O(1)/ Returns all characters after the head of a 'JSString', which+-- must be non-empty.  Subject to fusion.+tail :: JSString -> JSString+tail = coerce T.tail+{-# INLINE [1] tail #-}++{-# RULES+"JSSTRING tail -> fused" [~1] forall x.+    tail x = unstream (S.tail (stream x))+"JSSTRING tail -> unfused" [1] forall x.+    unstream (S.tail (stream x)) = tail x+ #-}++-- | /O(1)/ Returns all but the last character of a 'JSString', which must+-- be non-empty.  Subject to fusion.+init :: JSString -> JSString+init = coerce T.init+{-# INLINE [1] init #-}++{-# RULES+"JSSTRING init -> fused" [~1] forall t.+    init t = unstream (S.init (stream t))+"JSSTRING init -> unfused" [1] forall t.+    unstream (S.init (stream t)) = init t+ #-}++-- | /O(1)/ Tests whether a 'JSString' is empty or not.  Subject to+-- fusion.+null :: JSString -> Bool+null = coerce T.null+{-# INLINE [1] null #-}++{-# RULES+"JSSTRING null -> fused" [~1] forall t.+    null t = S.null (stream t)+"JSSTRING null -> unfused" [1] forall t.+    S.null (stream t) = null t+ #-}++-- | /O(n)/ Returns the number of characters in a 'JSString'.+-- Subject to fusion.+length :: JSString -> Int+length = coerce T.length+{-# INLINE [1] length #-}++{-# RULES+"JSSTRING length -> fused" [~1] forall x.+    length x = S.length (stream x)+"JSSTRING length -> unfused" [1] forall x.+    S.length (stream x) = length x+ #-}++-- | /O(n)/ Compare the count of characters in a 'JSString' to a number.+-- Subject to fusion.+--+-- This function gives the same answer as comparing against the result+-- of 'length', but can short circuit if the count of characters is+-- greater than the number, and hence be more efficient.+compareLength :: JSString -> Int -> Ordering+compareLength = coerce T.compareLength+{-# INLINE [1] compareLength #-}++{-# RULES+"JSSTRING compareN/length -> compareLength" [~1] forall t n.+    compare (length t) n = compareLength t n+  #-}++{-# RULES+"JSSTRING ==N/length -> compareLength/==EQ" [~1] forall t n.+    (==) (length t) n = compareLength t n == EQ+  #-}++{-# RULES+"JSSTRING /=N/length -> compareLength//=EQ" [~1] forall t n.+    (/=) (length t) n = compareLength t n /= EQ+  #-}++{-# RULES+"JSSTRING <N/length -> compareLength/==LT" [~1] forall t n.+    (<) (length t) n = compareLength t n == LT+  #-}++{-# RULES+"JSSTRING <=N/length -> compareLength//=GT" [~1] forall t n.+    (<=) (length t) n = compareLength t n /= GT+  #-}++{-# RULES+"JSSTRING >N/length -> compareLength/==GT" [~1] forall t n.+    (>) (length t) n = compareLength t n == GT+  #-}++{-# RULES+"JSSTRING >=N/length -> compareLength//=LT" [~1] forall t n.+    (>=) (length t) n = compareLength t n /= LT+  #-}++-- -----------------------------------------------------------------------------+-- * Transformations+-- | /O(n)/ 'map' @f@ @t@ is the 'JSString' obtained by applying @f@ to+-- each element of @t@.  Subject to fusion.  Performs replacement on+-- invalid scalar values.+map :: (Char -> Char) -> JSString -> JSString+map = coerce T.map+{-# INLINE [1] map #-}++-- | /O(n)/ The 'intercalate' function takes a 'JSString' and a list of+-- 'JSString's and concatenates the list after interspersing the first+-- argument between each element of the list.+intercalate :: JSString -> [JSString] -> JSString+intercalate = coerce T.intercalate+{-# INLINE [1] intercalate #-}++-- | /O(n)/ The 'intersperse' function takes a character and places it+-- between the characters of a 'JSString'.  Subject to fusion.  Performs+-- replacement on invalid scalar values.+intersperse     :: Char -> JSString -> JSString+intersperse = coerce T.intersperse+{-# INLINE [1] intersperse #-}++{-# RULES+"JSSTRING intersperse -> fused" [~1] forall c x.+    intersperse c x = unstream (S.intersperse (safe c) (stream x))+"JSSTRING intersperse -> unfused" [1] forall c x.+    unstream (S.intersperse (safe c) (stream x)) = intersperse c x+ #-}++-- | /O(n)/ Reverse the characters of a string. Subject to fusion.+reverse :: JSString -> JSString+reverse = coerce T.reverse+{-# INLINE [1] reverse #-}++{-# RULES+"JSSTRING reverse -> fused" [~1] forall x.+    reverse x = S.reverse (stream x)+"JSSTRING reverse -> unfused" [1] forall x.+    S.reverse (stream x) = reverse x+ #-}++-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in+-- @haystack@ with @replacement@.+--+-- This function behaves as though it was defined as follows:+--+-- @+-- replace needle replacement haystack =+--   'intercalate' replacement ('splitOn' needle haystack)+-- @+--+-- As this suggests, each occurrence is replaced exactly once.  So if+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself+-- be replaced recursively:+--+-- > replace "oo" "foo" "oo" == "foo"+--+-- In cases where several instances of @needle@ overlap, only the+-- first one will be replaced:+--+-- > replace "ofo" "bar" "ofofo" == "barfo"+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+replace :: JSString+        -- ^ @needle@ to search for.  If this string is empty, an+        -- error will occur.+        -> JSString+        -- ^ @replacement@ to replace @needle@ with.+        -> JSString+        -- ^ @haystack@ in which to search.+        -> JSString+replace = coerce T.replace+{-# INLINE replace #-}++-- ----------------------------------------------------------------------------+-- ** Case conversions (folds)++-- $case+--+-- When case converting 'JSString' values, do not use combinators like+-- @map toUpper@ to case convert each character of a string+-- individually, as this gives incorrect results according to the+-- rules of some writing systems.  The whole-string case conversion+-- functions from this module, such as @toUpper@, obey the correct+-- case conversion rules.  As a result, these functions may map one+-- input character to two or three output characters. For examples,+-- see the documentation of each function.+--+-- /Note/: In some languages, case conversion is a locale- and+-- context-dependent operation. The case conversion functions in this+-- module are /not/ locale sensitive. Programs that require locale+-- sensitivity should use appropriate versions of the+-- <http://hackage.haskell.org/package/text-icu-0.6.3.7/docs/Data-Text-ICU.html#g:4 case mapping functions from the text-icu package >.++-- | /O(n)/ Convert a string to folded case.  Subject to fusion.+--+-- This function is mainly useful for performing caseless (also known+-- as case insensitive) string comparisons.+--+-- A string @x@ is a caseless match for a string @y@ if and only if:+--+-- @toCaseFold x == toCaseFold y@+--+-- The result string may be longer than the input string, and may+-- differ from applying 'toLower' to the input string.  For instance,+-- the Armenian small ligature \"&#xfb13;\" (men now, U+FB13) is case+-- folded to the sequence \"&#x574;\" (men, U+0574) followed by+-- \"&#x576;\" (now, U+0576), while the Greek \"&#xb5;\" (micro sign,+-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)+-- instead of itself.+toCaseFold :: JSString -> JSString+toCaseFold = coerce T.toCaseFold+{-# INLINE [0] toCaseFold #-}++-- | /O(n)/ Convert a string to lower case, using simple case+-- conversion.  Subject to fusion.+--+-- The result string may be longer than the input string.  For+-- instance, \"&#x130;\" (Latin capital letter I with dot above,+-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)+-- followed by \" &#x307;\" (combining dot above, U+0307).+toLower :: JSString -> JSString+toLower = coerce T.toLower+{-# INLINE [1] toLower #-}++{-# RULES+"JSSTRING toLower -> fused" [~1] forall x.+    toLower x = unstream (S.toLower (stream x))+"JSSTRING toLower -> unfused" [1] forall x.+    unstream (S.toLower (stream x)) = toLower x+ #-}++-- | /O(n)/ Convert a string to upper case, using simple case+-- conversion.  Subject to fusion.+--+-- The result string may be longer than the input string.  For+-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the+-- two-letter sequence \"SS\".+toUpper :: JSString -> JSString+toUpper = coerce T.toUpper+{-# INLINE [1] toUpper #-}++{-# RULES+"JSSTRING toUpper -> fused" [~1] forall x.+    toUpper x = unstream (S.toUpper(stream x))+"JSSTRING toUpper -> unfused" [1] forall x.+    unstream (S.toUpper (stream x)) = toUpper x+ #-}++-- | /O(n)/ Convert a string to title case, using simple case+-- conversion. Subject to fusion.+--+-- The first letter of the input is converted to title case, as is+-- every subsequent letter that immediately follows a non-letter.+-- Every letter that immediately follows another letter is converted+-- to lower case.+--+-- The result string may be longer than the input string. For example,+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the+-- sequence Latin capital letter F (U+0046) followed by Latin small+-- letter l (U+006C).+--+-- /Note/: this function does not take language or culture specific+-- rules into account. For instance, in English, different style+-- guides disagree on whether the book name \"The Hill of the Red+-- Fox\" is correctly title cased&#x2014;but this function will+-- capitalize /every/ word.+toTitle :: JSString -> JSString+toTitle = coerce T.toTitle+{-# INLINE toTitle #-}++-- | /O(n)/ Left-justify a string to the given length, using the+-- specified fill character on the right. Subject to fusion.+-- Performs replacement on invalid scalar values.+--+-- Examples:+--+-- > justifyLeft 7 'x' "foo"    == "fooxxxx"+-- > justifyLeft 3 'x' "foobar" == "foobar"+justifyLeft :: Int -> Char -> JSString -> JSString+justifyLeft = coerce T.justifyLeft+{-# INLINE [1] justifyLeft #-}++{-# RULES+"JSSTRING justifyLeft -> fused" [~1] forall k c t.+    justifyLeft k c t = unstream (S.justifyLeftI k c (stream t))+"JSSTRING justifyLeft -> unfused" [1] forall k c t.+    unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t+  #-}++-- | /O(n)/ Right-justify a string to the given length, using the+-- specified fill character on the left.  Performs replacement on+-- invalid scalar values.+--+-- Examples:+--+-- > justifyRight 7 'x' "bar"    == "xxxxbar"+-- > justifyRight 3 'x' "foobar" == "foobar"+justifyRight :: Int -> Char -> JSString -> JSString+justifyRight = coerce T.justifyRight+{-# INLINE justifyRight #-}++-- | /O(n)/ Center a string to the given length, using the specified+-- fill character on either side.  Performs replacement on invalid+-- scalar values.+--+-- Examples:+--+-- > center 8 'x' "HS" = "xxxHSxxx"+center :: Int -> Char -> JSString -> JSString+center = coerce T.center+{-# INLINE center #-}++-- | /O(n)/ The 'transpose' function transposes the rows and columns+-- of its 'JSString' argument.  Note that this function uses 'pack',+-- 'unpack', and the list version of transpose, and is thus not very+-- efficient.+transpose :: [JSString] -> [JSString]+transpose = coerce T.transpose++-- -----------------------------------------------------------------------------+-- * Reducing 'JSString's (folds)++-- | /O(n)/ 'foldl', applied to a binary operator, a starting value+-- (typically the left-identity of the operator), and a 'JSString',+-- reduces the 'JSString' using the binary operator, from left to right.+-- Subject to fusion.+foldl :: (a -> Char -> a) -> a -> JSString -> a+foldl f = coerce (T.foldl f)+{-# INLINE foldl #-}++-- | /O(n)/ A strict version of 'foldl'.  Subject to fusion.+foldl' :: (a -> Char -> a) -> a -> JSString -> a+foldl' f = coerce (T.foldl' f)+{-# INLINE foldl' #-}++-- | /O(n)/ A variant of 'foldl' that has no starting value argument,+-- and thus must be applied to a non-empty 'JSString'.  Subject to fusion.+foldl1 :: (Char -> Char -> Char) -> JSString -> Char+foldl1 = coerce T.foldl1+{-# INLINE foldl1 #-}++-- | /O(n)/ A strict version of 'foldl1'.  Subject to fusion.+foldl1' :: (Char -> Char -> Char) -> JSString -> Char+foldl1' = coerce T.foldl1'+{-# INLINE foldl1' #-}++-- | /O(n)/ 'foldr', applied to a binary operator, a starting value+-- (typically the right-identity of the operator), and a 'JSString',+-- reduces the 'JSString' using the binary operator, from right to left.+-- Subject to fusion.+foldr :: (Char -> a -> a) -> a -> JSString -> a+foldr f = coerce (T.foldr f)+{-# INLINE foldr #-}++-- | /O(n)/ A variant of 'foldr' that has no starting value argument,+-- and thus must be applied to a non-empty 'JSString'.  Subject to+-- fusion.+foldr1 :: (Char -> Char -> Char) -> JSString -> Char+foldr1 = coerce T.foldr1+{-# INLINE foldr1 #-}++-- -----------------------------------------------------------------------------+-- ** Special folds++-- | /O(n)/ Concatenate a list of 'JSString's.+concat :: [JSString] -> JSString+concat = coerce T.concat++-- | /O(n)/ Map a function over a 'JSString' that results in a 'JSString', and+-- concatenate the results.+concatMap :: (Char -> JSString) -> JSString -> JSString+concatMap = coerce T.concatMap+{-# INLINE concatMap #-}++-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the+-- 'JSString' @t@ satisifes the predicate @p@. Subject to fusion.+any :: (Char -> Bool) -> JSString -> Bool+any = coerce T.any+{-# INLINE any #-}++-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the+-- 'JSString' @t@ satisify the predicate @p@. Subject to fusion.+all :: (Char -> Bool) -> JSString -> Bool+all = coerce T.all+{-# INLINE all #-}++-- | /O(n)/ 'maximum' returns the maximum value from a 'JSString', which+-- must be non-empty. Subject to fusion.+maximum :: JSString -> Char+maximum = coerce T.maximum+{-# INLINE maximum #-}++-- | /O(n)/ 'minimum' returns the minimum value from a 'JSString', which+-- must be non-empty. Subject to fusion.+minimum :: JSString -> Char+minimum = coerce T.minimum+{-# INLINE minimum #-}++-- -----------------------------------------------------------------------------+-- * Building 'JSString's++-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of+-- successive reduced values from the left. Subject to fusion.+-- Performs replacement on invalid scalar values.+--+-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+--+-- Note that+--+-- > last (scanl f z xs) == foldl f z xs.+scanl :: (Char -> Char -> Char) -> Char -> JSString -> JSString+scanl = coerce T.scanl+{-# INLINE scanl #-}++-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting+-- value argument.  Subject to fusion.  Performs replacement on+-- invalid scalar values.+--+-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]+scanl1 :: (Char -> Char -> Char) -> JSString -> JSString+scanl1 = coerce T.scanl1+{-# INLINE scanl1 #-}++-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.  Performs+-- replacement on invalid scalar values.+--+-- > scanr f v == reverse . scanl (flip f) v . reverse+scanr :: (Char -> Char -> Char) -> Char -> JSString -> JSString+scanr = coerce T.scanr+{-# INLINE scanr #-}++-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting+-- value argument.  Subject to fusion.  Performs replacement on+-- invalid scalar values.+scanr1 :: (Char -> Char -> Char) -> JSString -> JSString+scanr1 = coerce T.scanr1+{-# INLINE scanr1 #-}++-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a+-- function to each element of a 'JSString', passing an accumulating+-- parameter from left to right, and returns a final 'JSString'.  Performs+-- replacement on invalid scalar values.+mapAccumL :: (a -> Char -> (a,Char)) -> a -> JSString -> (a, JSString)+mapAccumL f = coerce (T.mapAccumL f)+{-# INLINE mapAccumL #-}++-- | The 'mapAccumR' function behaves like a combination of 'map' and+-- a strict 'foldr'; it applies a function to each element of a+-- 'JSString', passing an accumulating parameter from right to left, and+-- returning a final value of this accumulator together with the new+-- 'JSString'.+-- Performs replacement on invalid scalar values.+mapAccumR :: (a -> Char -> (a,Char)) -> a -> JSString -> (a, JSString)+mapAccumR f = coerce (T.mapAccumR f)+{-# INLINE mapAccumR #-}++-- -----------------------------------------------------------------------------+-- ** Generating and unfolding 'JSString's++-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'JSString' consisting of the input+-- @t@ repeated @n@ times.+replicate :: Int -> JSString -> JSString+replicate = coerce T.replicate+{-# INLINE [1] replicate #-}++-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'+-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a+-- 'JSString' from a seed value. The function takes the element and+-- returns 'Nothing' if it is done producing the 'JSString', otherwise+-- 'Just' @(a,b)@.  In this case, @a@ is the next 'Char' in the+-- string, and @b@ is the seed value for further production. Subject+-- to fusion.  Performs replacement on invalid scalar values.+unfoldr     :: (a -> Maybe (Char,a)) -> a -> JSString+unfoldr f = coerce (T.unfoldr f)+{-# INLINE unfoldr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'JSString' from a seed+-- value. However, the length of the result should be limited by the+-- first argument to 'unfoldrN'. This function is more efficient than+-- 'unfoldr' when the maximum length of the result is known and+-- correct, otherwise its performance is similar to 'unfoldr'. Subject+-- to fusion.  Performs replacement on invalid scalar values.+unfoldrN     :: Int -> (a -> Maybe (Char,a)) -> a -> JSString+unfoldrN n f = coerce (T.unfoldrN n f)+{-# INLINE unfoldrN #-}++-- -----------------------------------------------------------------------------+-- * Substrings++-- | /O(n)/ 'take' @n@, applied to a 'JSString', returns the prefix of the+-- 'JSString' of length @n@, or the 'JSString' itself if @n@ is greater than+-- the length of the JSString. Subject to fusion.+take :: Int -> JSString -> JSString+take = coerce T.take+{-# INLINE [1] take #-}+{-+iterN :: Int -> JSString -> Int+iterN n t@(Text _arr _off len) = loop 0 0+  where loop !i !cnt+            | i >= len || cnt >= n = i+            | otherwise            = loop (i+d) (cnt+1)+          where d = iter_ t i+-}+{-# RULES+"JSSTRING take -> fused" [~1] forall n t.+    take n t = unstream (S.take n (stream t))+"JSSTRING take -> unfused" [1] forall n t.+    unstream (S.take n (stream t)) = take n t+  #-}++-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after+-- taking @n@ characters from the end of @t@.+--+-- Examples:+--+-- > takeEnd 3 "foobar" == "bar"+takeEnd :: Int -> JSString -> JSString+takeEnd = coerce T.takeEnd++-- | /O(n)/ 'drop' @n@, applied to a 'JSString', returns the suffix of the+-- 'JSString' after the first @n@ characters, or the empty 'JSString' if @n@+-- is greater than the length of the 'JSString'. Subject to fusion.+drop :: Int -> JSString -> JSString+drop = coerce T.drop+{-# INLINE [1] drop #-}++{-# RULES+"JSSTRING drop -> fused" [~1] forall n t.+    drop n t = unstream (S.drop n (stream t))+"JSSTRING drop -> unfused" [1] forall n t.+    unstream (S.drop n (stream t)) = drop n t+  #-}++-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after+-- dropping @n@ characters from the end of @t@.+--+-- Examples:+--+-- > dropEnd 3 "foobar" == "foo"+dropEnd :: Int -> JSString -> JSString+dropEnd = coerce T.dropEnd++-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'JSString',+-- returns the longest prefix (possibly empty) of elements that+-- satisfy @p@.  Subject to fusion.+takeWhile :: (Char -> Bool) -> JSString -> JSString+takeWhile = coerce T.takeWhile+{-# INLINE [1] takeWhile #-}++{-# RULES+"TEXT takeWhile -> fused" [~1] forall p t.+    takeWhile p t = unstream (S.takeWhile p (stream t))+"TEXT takeWhile -> unfused" [1] forall p t.+    unstream (S.takeWhile p (stream t)) = takeWhile p t+  #-}++-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after+-- 'takeWhile' @p@ @t@. Subject to fusion.+dropWhile :: (Char -> Bool) -> JSString -> JSString+dropWhile = coerce T.dropWhile+{-# INLINE [1] dropWhile #-}++{-# RULES+"TEXT dropWhile -> fused" [~1] forall p t.+    dropWhile p t = unstream (S.dropWhile p (stream t))+"TEXT dropWhile -> unfused" [1] forall p t.+    unstream (S.dropWhile p (stream t)) = dropWhile p t+  #-}++-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after+-- dropping characters that fail the predicate @p@ from the end of+-- @t@.  Subject to fusion.+-- Examples:+--+-- > dropWhileEnd (=='.') "foo..." == "foo"+dropWhileEnd :: (Char -> Bool) -> JSString -> JSString+dropWhileEnd = coerce T.dropWhileEnd+{-# INLINE [1] dropWhileEnd #-}++{-# RULES+"TEXT dropWhileEnd -> fused" [~1] forall p t.+    dropWhileEnd p t = S.reverse (S.dropWhile p (S.reverseStream t))+"TEXT dropWhileEnd -> unfused" [1] forall p t.+    S.reverse (S.dropWhile p (S.reverseStream t)) = dropWhileEnd p t+  #-}++-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after+-- dropping characters that fail the predicate @p@ from both the+-- beginning and end of @t@.  Subject to fusion.+dropAround :: (Char -> Bool) -> JSString -> JSString+dropAround = coerce T.dropAround+{-# INLINE [1] dropAround #-}++-- | /O(n)/ Remove leading white space from a string.  Equivalent to:+--+-- > dropWhile isSpace+stripStart :: JSString -> JSString+stripStart = coerce T.stripStart+{-# INLINE [1] stripStart #-}++-- | /O(n)/ Remove trailing white space from a string.  Equivalent to:+--+-- > dropWhileEnd isSpace+stripEnd :: JSString -> JSString+stripEnd = coerce T.stripEnd+{-# INLINE [1] stripEnd #-}++-- | /O(n)/ Remove leading and trailing white space from a string.+-- Equivalent to:+--+-- > dropAround isSpace+strip :: JSString -> JSString+strip = coerce T.strip+{-# INLINE [1] strip #-}++-- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a+-- prefix of @t@ of length @n@, and whose second is the remainder of+-- the string. It is equivalent to @('take' n t, 'drop' n t)@.+splitAt :: Int -> JSString -> (JSString, JSString)+splitAt = coerce T.splitAt+{-# INLINE splitAt #-}++-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns+-- a pair whose first element is the longest prefix (possibly empty)+-- of @t@ of elements that satisfy @p@, and whose second is the+-- remainder of the list.+span :: (Char -> Bool) -> JSString -> (JSString, JSString)+span = coerce T.span+{-# INLINE span #-}++-- | /O(n)/ 'break' is like 'span', but the prefix returned is+-- over elements that fail the predicate @p@.+break :: (Char -> Bool) -> JSString -> (JSString, JSString)+break = coerce T.break+{-# INLINE break #-}++-- | /O(n)/ Group characters in a string according to a predicate.+groupBy :: (Char -> Char -> Bool) -> JSString -> [JSString]+groupBy = coerce T.groupBy++-- | /O(n)/ Group characters in a string by equality.+group :: JSString -> [JSString]+group = coerce T.group+{-# INLINE group #-}++group' :: JSString -> [JSString]+group' = coerce T.group+{-# INLINE group' #-}++-- | /O(n^2)/ Return all initial segments of the given 'JSString', shortest+-- first.+inits :: JSString -> [JSString]+inits = coerce T.inits++-- | /O(n^2)/ Return all final segments of the given 'JSString', longest+-- first.+tails :: JSString -> [JSString]+tails = coerce T.tails++-- $split+--+-- Splitting functions in this library do not perform character-wise+-- copies to create substrings; they just construct new 'JSString's that+-- are slices of the original.++-- | /O(m+n)/ Break a 'JSString' into pieces separated by the first 'JSString'+-- argument (which cannot be empty), consuming the delimiter. An empty+-- delimiter is invalid, and will cause an error to be raised.+--+-- Examples:+--+-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]+-- > splitOn "aaa"  "aaaXaaaXaaaXaaa"  == ["","X","X","X",""]+-- > splitOn "x"    "x"                == ["",""]+--+-- and+--+-- > intercalate s . splitOn s         == id+-- > splitOn (singleton c)             == split (==c)+--+-- (Note: the string @s@ to split on above cannot be empty.)+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+splitOn :: JSString+        -- ^ String to split on. If this string is empty, an error+        -- will occur.+        -> JSString+        -- ^ Input text.+        -> [JSString]+splitOn = coerce T.splitOn+{-# INLINE [1] splitOn #-}++-- RULES+-- "JSSTRING splitOn/singleton -> split/==" [~1] forall c t.+--    splitOn (singleton c) t = split (==c) t+--++splitOn' :: JSString+         -- ^ String to split on. If this string is empty, an error+         -- will occur.+         -> JSString+         -- ^ Input text.+         -> [JSString]+splitOn' = coerce T.splitOn+{-# NOINLINE splitOn' #-}+--- {-# INLINE [1] splitOn' #-}++-- | /O(n)/ Splits a 'JSString' into components delimited by separators,+-- where the predicate returns True for a separator element.  The+-- resulting components do not contain the separators.  Two adjacent+-- separators result in an empty component in the output.  eg.+--+-- > split (=='a') "aabbaca" == ["","","bb","c",""]+-- > split (=='a') ""        == [""]+split :: (Char -> Bool) -> JSString -> [JSString]+split = coerce T.split+{-# INLINE split #-}++-- | /O(n)/ Splits a 'JSString' into components of length @k@.  The last+-- element may be shorter than the other chunks, depending on the+-- length of the input. Examples:+--+-- > chunksOf 3 "foobarbaz"   == ["foo","bar","baz"]+-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]+chunksOf :: Int -> JSString -> [JSString]+chunksOf = coerce T.chunksOf+{-# INLINE chunksOf #-}++-- | /O(n)/ Splits a 'JSString' into components of length @k@.  The last+-- element may be shorter than the other chunks, depending on the+-- length of the input. Examples:+--+-- > chunksOf 3 "foobarbaz"   == ["foo","bar","baz"]+-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]+chunksOf' :: Int -> JSString -> [JSString]+chunksOf' = coerce T.chunksOf+{-# INLINE chunksOf' #-}++-- ----------------------------------------------------------------------------+-- * Searching++-------------------------------------------------------------------------------+-- ** Searching with a predicate++-- | /O(n)/ The 'find' function takes a predicate and a 'JSString', and+-- returns the first element matching the predicate, or 'Nothing' if+-- there is no such element.+find :: (Char -> Bool) -> JSString -> Maybe Char+find = coerce T.find+{-# INLINE find #-}++-- | /O(n)/ The 'partition' function takes a predicate and a 'JSString',+-- and returns the pair of 'JSString's with elements which do and do not+-- satisfy the predicate, respectively; i.e.+--+-- > partition p t == (filter p t, filter (not . p) t)+partition :: (Char -> Bool) -> JSString -> (JSString, JSString)+partition = coerce T.partition+{-# INLINE partition #-}++-- | /O(n)/ 'filter', applied to a predicate and a 'JSString',+-- returns a 'JSString' containing those characters that satisfy the+-- predicate.+filter :: (Char -> Bool) -> JSString -> JSString+filter = coerce T.filter+{-# INLINE filter #-}++-- | /O(n+m)/ Find the first instance of @needle@ (which must be+-- non-'null') in @haystack@.  The first element of the returned tuple+-- is the prefix of @haystack@ before @needle@ is matched.  The second+-- is the remainder of @haystack@, starting with the match.+--+-- Examples:+--+-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")+-- > breakOn "/" "foobar"   ==> ("foobar", "")+--+-- Laws:+--+-- > append prefix match == haystack+-- >   where (prefix, match) = breakOn needle haystack+--+-- If you need to break a string by a substring repeatedly (e.g. you+-- want to break on every instance of a substring), use 'breakOnAll'+-- instead, as it has lower startup overhead.+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+breakOn :: JSString -> JSString -> (JSString, JSString)+breakOn = coerce T.breakOn+{-# INLINE breakOn #-}++-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the+-- string.+--+-- The first element of the returned tuple is the prefix of @haystack@+-- up to and including the last match of @needle@.  The second is the+-- remainder of @haystack@, following the match.+--+-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")+breakOnEnd :: JSString -> JSString -> (JSString, JSString)+breakOnEnd = coerce T.breakOnEnd+{-# INLINE breakOnEnd #-}++-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in+-- @haystack@.  Each element of the returned list consists of a pair:+--+-- * The entire string prior to the /k/th match (i.e. the prefix)+--+-- * The /k/th match, followed by the remainder of the string+--+-- Examples:+--+-- > breakOnAll "::" ""+-- > ==> []+-- > breakOnAll "/" "a/b/c/"+-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+--+-- The @needle@ parameter may not be empty.+breakOnAll :: JSString              -- ^ @needle@ to search for+           -> JSString              -- ^ @haystack@ in which to search+           -> [(JSString, JSString)]+breakOnAll = coerce T.breakOnAll+{-# INLINE breakOnAll #-}++breakOnAll' :: JSString              -- ^ @needle@ to search for+            -> JSString              -- ^ @haystack@ in which to search+            -> [(JSString, JSString)]+breakOnAll' = coerce T.breakOnAll+{-# INLINE breakOnAll' #-}++-------------------------------------------------------------------------------+-- ** Indexing 'JSString's++-- $index+--+-- If you think of a 'JSString' value as an array of 'Char' values (which+-- it is not), you run the risk of writing inefficient code.+--+-- An idiom that is common in some languages is to find the numeric+-- offset of a character or substring, then use that number to split+-- or trim the searched string.  With a 'JSString' value, this approach+-- would require two /O(n)/ operations: one to perform the search, and+-- one to operate from wherever the search ended.+--+-- For example, suppose you have a string that you want to split on+-- the substring @\"::\"@, such as @\"foo::bar::quux\"@. Instead of+-- searching for the index of @\"::\"@ and taking the substrings+-- before and after that index, you would instead use @breakOnAll \"::\"@.++-- | /O(n)/ 'JSString' index (subscript) operator, starting from 0.+index :: JSString -> Int -> Char+index = coerce T.index+{-# INLINE index #-}++-- | /O(n)/ The 'findIndex' function takes a predicate and a 'JSString'+-- and returns the index of the first element in the 'JSString' satisfying+-- the predicate. Subject to fusion.+findIndex :: (Char -> Bool) -> JSString -> Maybe Int+findIndex = coerce T.findIndex+{-# INLINE findIndex #-}++-- | /O(n+m)/ The 'count' function returns the number of times the+-- query string appears in the given 'JSString'. An empty query string is+-- invalid, and will cause an error to be raised.+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+count :: JSString -> JSString -> Int+count = coerce T.count+{-# INLINE [1] count #-}++--  RULES+-- "JSSTRING count/singleton -> countChar" [~1] forall c t.+--    count (singleton c) t = countChar c t+--++-------------------------------------------------------------------------------+-- * Zipping++-- | /O(n)/ 'zip' takes two 'JSString's and returns a list of+-- corresponding pairs of bytes. If one input 'JSString' is short,+-- excess elements of the longer 'JSString' are discarded. This is+-- equivalent to a pair of 'unpack' operations.+zip :: JSString -> JSString -> [(Char,Char)]+zip = coerce T.zip+{-# INLINE [0] zip #-}++-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function+-- given as the first argument, instead of a tupling function.+-- Performs replacement on invalid scalar values.+zipWith :: (Char -> Char -> Char) -> JSString -> JSString -> JSString+zipWith = coerce T.zipWith+{-# INLINE [0] zipWith #-}++-- | /O(n)/ Breaks a 'JSString' up into a list of words, delimited by 'Char's+-- representing white space.+words :: JSString -> [JSString]+words = coerce T.words+{-# INLINE words #-}++-- fixme: strict words' that allocates the whole list in one go+words' :: JSString -> [JSString]+words' = coerce T.words+{-# INLINE words' #-}++-- | /O(n)/ Breaks a 'JSString' up into a list of 'JSString's at+-- newline 'Char's. The resulting strings do not contain newlines.+lines :: JSString -> [JSString]+lines = coerce T.lines+{-# INLINE lines #-}++lines' :: JSString -> [JSString]+lines' = coerce T.lines+{-# INLINE lines' #-}++{-+-- | /O(n)/ Portably breaks a 'JSString' up into a list of 'JSString's at line+-- boundaries.+--+-- A line boundary is considered to be either a line feed, a carriage+-- return immediately followed by a line feed, or a carriage return.+-- This accounts for both Unix and Windows line ending conventions,+-- and for the old convention used on Mac OS 9 and earlier.+lines' :: Text -> [Text]+lines' ps | null ps   = []+          | otherwise = h : case uncons t of+                              Nothing -> []+                              Just (c,t')+                                  | c == '\n' -> lines t'+                                  | c == '\r' -> case uncons t' of+                                                   Just ('\n',t'') -> lines t''+                                                   _               -> lines t'+    where (h,t)    = span notEOL ps+          notEOL c = c /= '\n' && c /= '\r'++-}++-- | /O(n)/ Joins lines, after appending a terminating newline to+-- each.+unlines :: [JSString] -> JSString+unlines = coerce T.unlines+{-# INLINE unlines #-}++-- | /O(n)/ Joins words using single space characters.+unwords :: [JSString] -> JSString+unwords = coerce T.unwords+{-# INLINE unwords #-}++-- | /O(n)/ The 'isPrefixOf' function takes two 'JSString's and returns+-- 'True' iff the first is a prefix of the second.  Subject to fusion.+isPrefixOf :: JSString -> JSString -> Bool+isPrefixOf = coerce T.isPrefixOf+{-# INLINE [1] isPrefixOf #-}++{-# RULES+"JSSTRING isPrefixOf -> fused" [~1] forall x y.+    isPrefixOf x y = S.isPrefixOf (stream x) (stream y)+"JSSTRING isPrefixOf -> unfused" [1] forall x y.+     S.isPrefixOf (stream x) (stream y) = isPrefixOf x y+  #-}++-- | /O(n)/ The 'isSuffixOf' function takes two 'JSString's and returns+-- 'True' iff the first is a suffix of the second.+isSuffixOf :: JSString -> JSString -> Bool+isSuffixOf = coerce T.isSuffixOf+{-# INLINE isSuffixOf #-}++-- | The 'isInfixOf' function takes two 'JSString's and returns+-- 'True' iff the first is contained, wholly and intact, anywhere+-- within the second.+--+-- Complexity depends on how the JavaScript engine implements+-- String.prototype.find.+isInfixOf :: JSString -> JSString -> Bool+isInfixOf = coerce T.isInfixOf+{-# INLINE [1] isInfixOf #-}++{-# RULES+"JSSTRING isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h.+    isInfixOf (singleton n) h = S.elem n (S.stream h)+  #-}++-------------------------------------------------------------------------------+-- * View patterns++-- | /O(n)/ Return the suffix of the second string if its prefix+-- matches the entire first string.+--+-- Examples:+--+-- > stripPrefix "foo" "foobar" == Just "bar"+-- > stripPrefix ""    "baz"    == Just "baz"+-- > stripPrefix "foo" "quux"   == Nothing+--+-- This is particularly useful with the @ViewPatterns@ extension to+-- GHC, as follows:+--+-- > {-# LANGUAGE ViewPatterns #-}+-- > import Data.Text as T+-- >+-- > fnordLength :: JSString -> Int+-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf+-- > fnordLength _                                 = -1+stripPrefix :: JSString -> JSString -> Maybe JSString+stripPrefix = coerce T.stripPrefix+{-# INLINE stripPrefix #-}++-- | /O(n)/ Find the longest non-empty common prefix of two strings+-- and return it, along with the suffixes of each string at which they+-- no longer match.+--+-- If the strings do not have a common prefix or either one is empty,+-- this function returns 'Nothing'.+--+-- Examples:+--+-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")+-- > commonPrefixes "veeble" "fetzer"  == Nothing+-- > commonPrefixes "" "baz"           == Nothing+commonPrefixes :: JSString -> JSString -> Maybe (JSString,JSString,JSString)+commonPrefixes = coerce T.commonPrefixes+{-# INLINE commonPrefixes #-}++-- | /O(n)/ Return the prefix of the second string if its suffix+-- matches the entire first string.+--+-- Examples:+--+-- > stripSuffix "bar" "foobar" == Just "foo"+-- > stripSuffix ""    "baz"    == Just "baz"+-- > stripSuffix "foo" "quux"   == Nothing+--+-- This is particularly useful with the @ViewPatterns@ extension to+-- GHC, as follows:+--+-- > {-# LANGUAGE ViewPatterns #-}+-- > import Data.Text as T+-- >+-- > quuxLength :: Text -> Int+-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre+-- > quuxLength _                                = -1+stripSuffix :: JSString -> JSString -> Maybe JSString+stripSuffix = coerce T.stripSuffix+{-# INLINE stripSuffix #-}++---- | Add a list of non-negative numbers.  Errors out on overflow.+--sumP :: String -> [Int] -> Int+--sumP fun = go 0+--  where go !a (x:xs)+--            | ax >= 0   = go ax xs+--            | otherwise = overflowError fun+--          where ax = a + x+--        go a  _         = a+--+--emptyError :: String -> a+--emptyError fun = P.error $ "Data.JSString." ++ fun ++ ": empty input"+--+--overflowError :: String -> a+--overflowError fun = P.error $ "Data.JSString." ++ fun ++ ": size overflow"+--+--charWidth :: Int# -> Int#+--charWidth cp | isTrue# (cp >=# 0x10000#) = 2#+--             | otherwise                 = 1#+--{-# INLINE charWidth #-}

@@ -0,0 +1,1 @@+module Data.JSString.Internal where

@@ -0,0 +1,127 @@+{-# LANGUAGE BangPatterns, MagicHash+  #-}+module Data.JSString.Internal.Fusion ( -- * Types+                                       Stream(..)+                                     , Step(..)++                                       -- * Creation and elimination+                                     , stream+                                     , unstream+                                     , reverseStream++                                     , length++                                       -- * Transformations+                                     , reverse++                                       -- * Construction+                                       -- ** Scans+                                     , reverseScanr++                                       -- ** Accumulating maps+                                     , mapAccumL++                                       -- ** Generation and unfolding+                                     , unfoldrN++                                       -- * Indexing+                                     , index+                                     , findIndex+                                     , countChar+                                     ) where++--import           GHC.Exts (Char(..), Int(..), chr#, Int#, isTrue#, (-#), (+#), (>=#))++import           Prelude hiding (length, reverse)+import qualified Data.Text.Internal.Fusion as T+--import           Data.Char+import           Data.Coerce (coerce)++import           Data.JSString.Internal.Type (JSString(..))+--import qualified Data.JSString.Internal.Type          as I+import           Data.JSString.Internal.Fusion.Types+import qualified Data.JSString.Internal.Fusion.Common as S++--import           System.IO.Unsafe++--import           GHCJS.Prim++default (Int)++-- | /O(n)/ Convert a 'JSString' into a 'Stream Char'.+stream :: JSString -> Stream Char+stream = coerce T.stream+{-# INLINE [0] stream #-}++-- | /O(n)/ Convert a 'JSString' into a 'Stream Char', but iterate+-- backwards.+reverseStream :: JSString -> Stream Char+reverseStream = coerce T.reverseStream+{-# INLINE [0] reverseStream #-}++-- | /O(n)/ Convert a 'Stream Char' into a 'JSString'.+unstream :: Stream Char -> JSString+unstream = coerce T.unstream+{-# INLINE [0] unstream #-}+{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}+++-- ----------------------------------------------------------------------------+-- * Basic stream functions++--runJSString :: ((a -> IO a) -> IO a) -> a+--runJSString f = unsafePerformIO (f pure)++length :: Stream Char -> Int+length = S.lengthI+{-# INLINE[0] length #-}++-- | /O(n)/ Reverse the characters of a string.+reverse :: Stream Char -> JSString+reverse = coerce T.reverse+{-# INLINE [0] reverse #-}++-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with+-- the input and result reversed.+reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char+reverseScanr = coerce T.reverseScanr+{-# INLINE reverseScanr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed+-- value. However, the length of the result is limited by the+-- first argument to 'unfoldrN'. This function is more efficient than+-- 'unfoldr' when the length of the result is known.+unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char+unfoldrN n = S.unfoldrNI n+{-# INLINE [0] unfoldrN #-}++-------------------------------------------------------------------------------+-- ** Indexing streams++-- | /O(n)/ stream index (subscript) operator, starting from 0.+index :: Stream Char -> Int -> Char+index = S.indexI+{-# INLINE [0] index #-}++-- | The 'findIndex' function takes a predicate and a stream and+-- returns the index of the first element in the stream+-- satisfying the predicate.+findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int+findIndex = S.findIndexI+{-# INLINE [0] findIndex #-}++-- | /O(n)/ The 'count' function returns the number of times the query+-- element appears in the given stream.+countChar :: Char -> Stream Char -> Int+countChar = S.countCharI+{-# INLINE [0] countChar #-}++-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a+-- function to each element of a 'Text', passing an accumulating+-- parameter from left to right, and returns a final 'JSString'.+mapAccumL :: (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, JSString)+mapAccumL a b c = coerce (T.mapAccumL a b c)+{-# INLINE [0] mapAccumL #-}++-------------------------------------------------------------------------------+

@@ -0,0 +1,570 @@+{-# LANGUAGE Rank2Types #-}+-- AUTOMATICALLY GENERATED - DO NOT EDIT+-- Generated by scripts/SpecialCasing.hs+-- CaseFolding-6.3.0.txt+-- Date: 2012-12-20, 22:14:35 GMT [MD]+-- SpecialCasing-6.3.0.txt+-- Date: 2013-05-08, 13:54:51 GMT [MD]++module Data.JSString.Internal.Fusion.CaseMapping where+import Data.Char+import Data.JSString.Internal.Fusion.Types++upperMapping :: forall s. Char -> s -> Step (CC s) Char+{-# INLINE upperMapping #-}+-- LATIN SMALL LETTER SHARP S+upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')+-- LATIN SMALL LIGATURE FF+upperMapping '\xfb00' s = Yield '\x0046' (CC s '\x0046' '\x0000')+-- LATIN SMALL LIGATURE FI+upperMapping '\xfb01' s = Yield '\x0046' (CC s '\x0049' '\x0000')+-- LATIN SMALL LIGATURE FL+upperMapping '\xfb02' s = Yield '\x0046' (CC s '\x004c' '\x0000')+-- LATIN SMALL LIGATURE FFI+upperMapping '\xfb03' s = Yield '\x0046' (CC s '\x0046' '\x0049')+-- LATIN SMALL LIGATURE FFL+upperMapping '\xfb04' s = Yield '\x0046' (CC s '\x0046' '\x004c')+-- LATIN SMALL LIGATURE LONG S T+upperMapping '\xfb05' s = Yield '\x0053' (CC s '\x0054' '\x0000')+-- LATIN SMALL LIGATURE ST+upperMapping '\xfb06' s = Yield '\x0053' (CC s '\x0054' '\x0000')+-- ARMENIAN SMALL LIGATURE ECH YIWN+upperMapping '\x0587' s = Yield '\x0535' (CC s '\x0552' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN NOW+upperMapping '\xfb13' s = Yield '\x0544' (CC s '\x0546' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN ECH+upperMapping '\xfb14' s = Yield '\x0544' (CC s '\x0535' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN INI+upperMapping '\xfb15' s = Yield '\x0544' (CC s '\x053b' '\x0000')+-- ARMENIAN SMALL LIGATURE VEW NOW+upperMapping '\xfb16' s = Yield '\x054e' (CC s '\x0546' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN XEH+upperMapping '\xfb17' s = Yield '\x0544' (CC s '\x053d' '\x0000')+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+upperMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+upperMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+upperMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- LATIN SMALL LETTER J WITH CARON+upperMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')+-- LATIN SMALL LETTER H WITH LINE BELOW+upperMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')+-- LATIN SMALL LETTER T WITH DIAERESIS+upperMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')+-- LATIN SMALL LETTER W WITH RING ABOVE+upperMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER Y WITH RING ABOVE+upperMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+upperMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI+upperMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+upperMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+upperMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+upperMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+upperMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+upperMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+upperMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+upperMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+upperMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+upperMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+upperMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+upperMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER RHO WITH PSILI+upperMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+upperMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+upperMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+upperMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1f80' s = Yield '\x1f08' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1f81' s = Yield '\x1f09' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f82' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f83' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f84' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f85' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f86' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f87' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1f88' s = Yield '\x1f08' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1f89' s = Yield '\x1f09' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f8a' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f8b' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f8c' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f8d' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f8e' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f8f' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1f90' s = Yield '\x1f28' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1f91' s = Yield '\x1f29' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f92' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f93' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f94' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f95' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f96' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f97' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1f98' s = Yield '\x1f28' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1f99' s = Yield '\x1f29' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f9a' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f9b' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f9c' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f9d' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f9e' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f9f' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1fa0' s = Yield '\x1f68' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1fa1' s = Yield '\x1f69' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1fa2' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1fa3' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1fa4' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1fa5' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fa6' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fa7' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1fa8' s = Yield '\x1f68' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1fa9' s = Yield '\x1f69' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1faa' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1fab' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1fac' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1fad' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1fae' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1faf' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI+upperMapping '\x1fb3' s = Yield '\x0391' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI+upperMapping '\x1fbc' s = Yield '\x0391' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI+upperMapping '\x1fc3' s = Yield '\x0397' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI+upperMapping '\x1fcc' s = Yield '\x0397' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI+upperMapping '\x1ff3' s = Yield '\x03a9' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI+upperMapping '\x1ffc' s = Yield '\x03a9' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0399')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')+upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')+lowerMapping :: forall s. Char -> s -> Step (CC s) Char+{-# INLINE lowerMapping #-}+-- LATIN CAPITAL LETTER I WITH DOT ABOVE+lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')+lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')+titleMapping :: forall s. Char -> s -> Step (CC s) Char+{-# INLINE titleMapping #-}+-- LATIN SMALL LETTER SHARP S+titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')+-- LATIN SMALL LIGATURE FF+titleMapping '\xfb00' s = Yield '\x0046' (CC s '\x0066' '\x0000')+-- LATIN SMALL LIGATURE FI+titleMapping '\xfb01' s = Yield '\x0046' (CC s '\x0069' '\x0000')+-- LATIN SMALL LIGATURE FL+titleMapping '\xfb02' s = Yield '\x0046' (CC s '\x006c' '\x0000')+-- LATIN SMALL LIGATURE FFI+titleMapping '\xfb03' s = Yield '\x0046' (CC s '\x0066' '\x0069')+-- LATIN SMALL LIGATURE FFL+titleMapping '\xfb04' s = Yield '\x0046' (CC s '\x0066' '\x006c')+-- LATIN SMALL LIGATURE LONG S T+titleMapping '\xfb05' s = Yield '\x0053' (CC s '\x0074' '\x0000')+-- LATIN SMALL LIGATURE ST+titleMapping '\xfb06' s = Yield '\x0053' (CC s '\x0074' '\x0000')+-- ARMENIAN SMALL LIGATURE ECH YIWN+titleMapping '\x0587' s = Yield '\x0535' (CC s '\x0582' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN NOW+titleMapping '\xfb13' s = Yield '\x0544' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN ECH+titleMapping '\xfb14' s = Yield '\x0544' (CC s '\x0565' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN INI+titleMapping '\xfb15' s = Yield '\x0544' (CC s '\x056b' '\x0000')+-- ARMENIAN SMALL LIGATURE VEW NOW+titleMapping '\xfb16' s = Yield '\x054e' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN XEH+titleMapping '\xfb17' s = Yield '\x0544' (CC s '\x056d' '\x0000')+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+titleMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+titleMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+titleMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- LATIN SMALL LETTER J WITH CARON+titleMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')+-- LATIN SMALL LETTER H WITH LINE BELOW+titleMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')+-- LATIN SMALL LETTER T WITH DIAERESIS+titleMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')+-- LATIN SMALL LETTER W WITH RING ABOVE+titleMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER Y WITH RING ABOVE+titleMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+titleMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI+titleMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+titleMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+titleMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+titleMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+titleMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+titleMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+titleMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+titleMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+titleMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+titleMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+titleMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+titleMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER RHO WITH PSILI+titleMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+titleMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+titleMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+titleMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0345')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')+titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')+foldMapping :: forall s. Char -> s -> Step (CC s) Char+{-# INLINE foldMapping #-}+-- MICRO SIGN+foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')+-- LATIN SMALL LETTER SHARP S+foldMapping '\x00df' s = Yield '\x0073' (CC s '\x0073' '\x0000')+-- LATIN CAPITAL LETTER I WITH DOT ABOVE+foldMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+foldMapping '\x0149' s = Yield '\x02bc' (CC s '\x006e' '\x0000')+-- LATIN SMALL LETTER LONG S+foldMapping '\x017f' s = Yield '\x0073' (CC s '\x0000' '\x0000')+-- LATIN SMALL LETTER J WITH CARON+foldMapping '\x01f0' s = Yield '\x006a' (CC s '\x030c' '\x0000')+-- COMBINING GREEK YPOGEGRAMMENI+foldMapping '\x0345' s = Yield '\x03b9' (CC s '\x0000' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+foldMapping '\x0390' s = Yield '\x03b9' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+foldMapping '\x03b0' s = Yield '\x03c5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER FINAL SIGMA+foldMapping '\x03c2' s = Yield '\x03c3' (CC s '\x0000' '\x0000')+-- GREEK BETA SYMBOL+foldMapping '\x03d0' s = Yield '\x03b2' (CC s '\x0000' '\x0000')+-- GREEK THETA SYMBOL+foldMapping '\x03d1' s = Yield '\x03b8' (CC s '\x0000' '\x0000')+-- GREEK PHI SYMBOL+foldMapping '\x03d5' s = Yield '\x03c6' (CC s '\x0000' '\x0000')+-- GREEK PI SYMBOL+foldMapping '\x03d6' s = Yield '\x03c0' (CC s '\x0000' '\x0000')+-- GREEK KAPPA SYMBOL+foldMapping '\x03f0' s = Yield '\x03ba' (CC s '\x0000' '\x0000')+-- GREEK RHO SYMBOL+foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')+-- GREEK LUNATE EPSILON SYMBOL+foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')+-- ARMENIAN SMALL LIGATURE ECH YIWN+foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')+-- GEORGIAN CAPITAL LETTER YN+foldMapping '\x10c7' s = Yield '\x2d27' (CC s '\x0000' '\x0000')+-- GEORGIAN CAPITAL LETTER AEN+foldMapping '\x10cd' s = Yield '\x2d2d' (CC s '\x0000' '\x0000')+-- LATIN SMALL LETTER H WITH LINE BELOW+foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')+-- LATIN SMALL LETTER T WITH DIAERESIS+foldMapping '\x1e97' s = Yield '\x0074' (CC s '\x0308' '\x0000')+-- LATIN SMALL LETTER W WITH RING ABOVE+foldMapping '\x1e98' s = Yield '\x0077' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER Y WITH RING ABOVE+foldMapping '\x1e99' s = Yield '\x0079' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+foldMapping '\x1e9a' s = Yield '\x0061' (CC s '\x02be' '\x0000')+-- LATIN SMALL LETTER LONG S WITH DOT ABOVE+foldMapping '\x1e9b' s = Yield '\x1e61' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER SHARP S+foldMapping '\x1e9e' s = Yield '\x0073' (CC s '\x0073' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI+foldMapping '\x1f50' s = Yield '\x03c5' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+foldMapping '\x1f52' s = Yield '\x03c5' (CC s '\x0313' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+foldMapping '\x1f54' s = Yield '\x03c5' (CC s '\x0313' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+foldMapping '\x1f56' s = Yield '\x03c5' (CC s '\x0313' '\x0342')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1f80' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1f81' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f82' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f83' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f84' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f85' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f86' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f87' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1f88' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1f89' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f8a' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f8b' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f8c' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f8d' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f8e' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f8f' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1f90' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1f91' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f92' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f93' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f94' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f95' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f96' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f97' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1f98' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1f99' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f9a' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f9b' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f9c' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f9d' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f9e' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f9f' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1fa0' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1fa1' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1fa2' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1fa3' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1fa4' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1fa5' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fa6' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fa7' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1fa8' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1fa9' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1faa' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1fab' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1fac' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1fad' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1fae' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1faf' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1fb2' s = Yield '\x1f70' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI+foldMapping '\x1fb3' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1fb4' s = Yield '\x03ac' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+foldMapping '\x1fb6' s = Yield '\x03b1' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fb7' s = Yield '\x03b1' (CC s '\x0342' '\x03b9')+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI+foldMapping '\x1fbc' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')+-- GREEK PROSGEGRAMMENI+foldMapping '\x1fbe' s = Yield '\x03b9' (CC s '\x0000' '\x0000')+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1fc2' s = Yield '\x1f74' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI+foldMapping '\x1fc3' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1fc4' s = Yield '\x03ae' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+foldMapping '\x1fc6' s = Yield '\x03b7' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fc7' s = Yield '\x03b7' (CC s '\x0342' '\x03b9')+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI+foldMapping '\x1fcc' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+foldMapping '\x1fd2' s = Yield '\x03b9' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+foldMapping '\x1fd3' s = Yield '\x03b9' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+foldMapping '\x1fd6' s = Yield '\x03b9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+foldMapping '\x1fd7' s = Yield '\x03b9' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+foldMapping '\x1fe2' s = Yield '\x03c5' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+foldMapping '\x1fe3' s = Yield '\x03c5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER RHO WITH PSILI+foldMapping '\x1fe4' s = Yield '\x03c1' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+foldMapping '\x1fe6' s = Yield '\x03c5' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+foldMapping '\x1fe7' s = Yield '\x03c5' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1ff2' s = Yield '\x1f7c' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI+foldMapping '\x1ff3' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1ff4' s = Yield '\x03ce' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI+foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')+-- COPTIC CAPITAL LETTER BOHAIRIC KHEI+foldMapping '\x2cf2' s = Yield '\x2cf3' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER C WITH BAR+foldMapping '\xa792' s = Yield '\xa793' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER H WITH HOOK+foldMapping '\xa7aa' s = Yield '\x0266' (CC s '\x0000' '\x0000')+-- LATIN SMALL LIGATURE FF+foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')+-- LATIN SMALL LIGATURE FI+foldMapping '\xfb01' s = Yield '\x0066' (CC s '\x0069' '\x0000')+-- LATIN SMALL LIGATURE FL+foldMapping '\xfb02' s = Yield '\x0066' (CC s '\x006c' '\x0000')+-- LATIN SMALL LIGATURE FFI+foldMapping '\xfb03' s = Yield '\x0066' (CC s '\x0066' '\x0069')+-- LATIN SMALL LIGATURE FFL+foldMapping '\xfb04' s = Yield '\x0066' (CC s '\x0066' '\x006c')+-- LATIN SMALL LIGATURE LONG S T+foldMapping '\xfb05' s = Yield '\x0073' (CC s '\x0074' '\x0000')+-- LATIN SMALL LIGATURE ST+foldMapping '\xfb06' s = Yield '\x0073' (CC s '\x0074' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN NOW+foldMapping '\xfb13' s = Yield '\x0574' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN ECH+foldMapping '\xfb14' s = Yield '\x0574' (CC s '\x0565' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN INI+foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')+-- ARMENIAN SMALL LIGATURE VEW NOW+foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN XEH+foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')+foldMapping c s = Yield (toLower c) (CC s '\0' '\0')

@@ -0,0 +1,92 @@+{-# LANGUAGE BangPatterns, MagicHash, RankNTypes #-}++module Data.JSString.Internal.Fusion.Common ( -- * Creation and elimination+                                              singleton+                                            , streamList+                                            , unstreamList+                                            , streamCString#++                                              -- * Basic interface+                                            , cons+                                            , snoc+                                            , append+                                            , head+                                            , uncons+                                            , last+                                            , tail+                                            , init+                                            , null+                                            , lengthI+                                            , compareLengthI+                                            , isSingleton++                                              -- * Transformations+                                            , map+                                            , intercalate+                                            , intersperse++                                              -- ** Case conversion+                                              -- $case+                                            , toCaseFold+                                            , toLower+                                            , toTitle+                                            , toUpper++                                              -- ** Justification+                                            , justifyLeftI++                                              -- * Folds+                                            , foldl+                                            , foldl'+                                            , foldl1+                                            , foldl1'+                                            , foldr+                                            , foldr1++                                              -- ** Special folds+                                            , concat+                                            , concatMap+                                            , any+                                            , all+                                            , maximum+                                            , minimum++                                              -- * Construction+                                              -- ** Scans+                                            , scanl++                                              -- ** Accumulating maps+                                              -- , mapAccumL++                                              -- ** Generation and unfolding+                                            , replicateCharI+                                            , replicateI+                                            , unfoldr+                                            , unfoldrNI++                                              -- * Substrings+                                              -- ** Breaking strings+                                            , take+                                            , drop+                                            , takeWhile+                                            , dropWhile++                                              -- * Predicates+                                            , isPrefixOf++                                              -- * Searching+                                            , elem+                                            , filter++                                              -- * Indexing+                                            , findBy+                                            , indexI+                                            , findIndexI+                                            , countCharI++                                              -- * Zipping and unzipping+                                            , zipWith+                                            ) where++import Data.Text.Internal.Fusion.Common+import Prelude ()

@@ -0,0 +1,122 @@+{-# LANGUAGE BangPatterns, ExistentialQuantification #-}+-- |+-- Module      : Data.Text.Internal.Fusion.Types+-- Copyright   : (c) Tom Harper 2008-2009,+--               (c) Bryan O'Sullivan 2009,+--               (c) Duncan Coutts 2009,+--               (c) Jasper Van der Jeugt 2011+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Core stream fusion functionality for text.++module Data.JSString.Internal.Fusion.Types+    (+      CC(..)+--    , M(..)+--    , M8+    , PairS(..)+    , RS(..)+    , Step(..)+    , Stream(..)+--    , Switch(..)+    , empty+    ) where++import Data.Text.Internal.Fusion.Types+-- import Data.Text.Internal.Fusion.Size+-- import Data.Word (Word8)++---- | Specialised tuple for case conversion.+--data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char+--+---- | Specialised, strict Maybe-like type.+--data M a = N+--         | J !a+--+--type M8 = M Word8+--+---- Restreaming state.+--data RS s+--    = RS0 !s+--    | RS1 !s {-# UNPACK #-} !Word8+--    | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+--    | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+--+--infixl 2 :*:+--data PairS a b = !a :*: !b+--                 -- deriving (Eq, Ord, Show)+--+---- | Allow a function over a stream to switch between two states.+--data Switch = S1 | S2+--+--data Step s a = Done+--              | Skip !s+--              | Yield !a !s+--+--{-+--instance (Show a) => Show (Step s a)+--    where show Done        = "Done"+--          show (Skip _)    = "Skip"+--          show (Yield x _) = "Yield " ++ show x+---}+--+--instance (Eq a) => Eq (Stream a) where+--    (==) = eq+--+--instance (Ord a) => Ord (Stream a) where+--    compare = cmp+--+---- The length hint in a Stream has two roles.  If its value is zero,+---- we trust it, and treat the stream as empty.  Otherwise, we treat it+---- as a hint: it should usually be accurate, so we use it when+---- unstreaming to decide what size array to allocate.  However, the+---- unstreaming functions must be able to cope with the hint being too+---- small or too large.+--+--data Stream a =+--    forall s. Stream+--    (s -> Step s a)             -- stepper function+--    !s                          -- current state+--+---- | /O(n)/ Determines if two streams are equal.+--eq :: (Eq a) => Stream a -> Stream a -> Bool+--eq (Stream next1 s1) (Stream next2 s2) = loop (next1 s1) (next2 s2)+--    where+--      loop Done Done                     = True+--      loop (Skip s1')     (Skip s2')     = loop (next1 s1') (next2 s2')+--      loop (Skip s1')     x2             = loop (next1 s1') x2+--      loop x1             (Skip s2')     = loop x1          (next2 s2')+--      loop Done _                        = False+--      loop _    Done                     = False+--      loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&+--                                           loop (next1 s1') (next2 s2')+--{-# INLINE [0] eq #-}+--+--cmp :: (Ord a) => Stream a -> Stream a -> Ordering+--cmp (Stream next1 s1) (Stream next2 s2) = loop (next1 s1) (next2 s2)+--    where+--      loop Done Done                     = EQ+--      loop (Skip s1')     (Skip s2')     = loop (next1 s1') (next2 s2')+--      loop (Skip s1')     x2             = loop (next1 s1') x2+--      loop x1             (Skip s2')     = loop x1          (next2 s2')+--      loop Done _                        = LT+--      loop _    Done                     = GT+--      loop (Yield x1 s1') (Yield x2 s2') =+--          case compare x1 x2 of+--            EQ    -> loop (next1 s1') (next2 s2')+--            other -> other+--{-# INLINE [0] cmp #-}+--+---- | The empty stream.+--empty :: Stream a+--empty = Stream next ()+--    where next _ = Done+--{-# INLINE [0] empty #-}

@@ -0,0 +1,11 @@+module Data.JSString.Internal.Search ( indices+                                     ) where++import Data.Coerce (coerce)++import Data.JSString.Internal.Type (JSString(..))++import qualified Data.Text.Internal.Search as T++indices :: JSString -> JSString -> [Int]+indices = coerce T.indices

@@ -0,0 +1,115 @@+{-# LANGUAGE DeriveDataTypeable, UnboxedTuples, MagicHash,+             BangPatterns, GeneralizedNewtypeDeriving #-}+{-# OPTIONS_HADDOCK not-home #-}+module Data.JSString.Internal.Type ( JSString(..)+                                   , empty+                                   , empty_+                                   , safe+                                   , firstf+                                   ) where++                                     {-+    -- * Construction+    , text+    , textP+    -- * Safety+    , safe+    -- * Code that must be here for accessibility+    , empty+    , empty_+    -- * Utilities+    , firstf+    -- * Checked multiplication+    , mul+    , mul32+    , mul64+    -- * Debugging+    , showText++                                   ) where+-}+import Control.DeepSeq++import Data.Coerce                    (coerce)+import Data.Text                      (Text)+import qualified Data.Text as T       (empty)+import Data.String                    (IsString)+import Data.Aeson                     (ToJSON(..), FromJSON(..))+import Data.Data                      (Data)+-- import Data.Text.Internal.Unsafe.Char (ord)+import Data.Typeable                  (Typeable)+import GHC.Exts                       (Char(..), ord#, andI#, (/=#), isTrue#)++-- | A wrapper around a JavaScript string+newtype JSString = JSString Text deriving(Show, Read, IsString, Monoid, Ord, Eq, Data, ToJSON, FromJSON, Typeable)++instance NFData JSString where rnf !_ = ()++-- | /O(1)/ The empty 'JSString'.+empty :: JSString+empty = coerce T.empty+{-# INLINE [1] empty #-}++-- | A non-inlined version of 'empty'.+empty_ :: JSString+empty_ = coerce T.empty+{-# NOINLINE empty_ #-}++safe :: Char -> Char+safe c@(C# cc)+    | isTrue# (andI# (ord# cc) 0x1ff800# /=# 0xd800#) = c+    | otherwise                    = '\xfffd'+{-# INLINE [0] safe #-}+++-- | Apply a function to the first element of an optional pair.+firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)+firstf f (Just (a, b)) = Just (f a, b)+firstf _  Nothing      = Nothing++{-+-- | Checked multiplication.  Calls 'error' if the result would+-- overflow.+mul :: Int -> Int -> Int+#if WORD_SIZE_IN_BITS == 64+mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b+#else+mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b+#endif+{-# INLINE mul #-}+infixl 7 `mul`++-- | Checked multiplication.  Calls 'error' if the result would+-- overflow.+mul64 :: Int64 -> Int64 -> Int64+mul64 a b+  | a >= 0 && b >= 0 =  mul64_ a b+  | a >= 0           = -mul64_ a (-b)+  | b >= 0           = -mul64_ (-a) b+  | otherwise        =  mul64_ (-a) (-b)+{-# INLINE mul64 #-}+infixl 7 `mul64`++mul64_ :: Int64 -> Int64 -> Int64+mul64_ a b+  | ahi > 0 && bhi > 0 = error "overflow"+  | top > 0x7fffffff   = error "overflow"+  | total < 0          = error "overflow"+  | otherwise          = total+  where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)+        (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)+        top            = ahi * blo + alo * bhi+        total          = (top `shiftL` 32) + alo * blo+{-# INLINE mul64_ #-}++-- | Checked multiplication.  Calls 'error' if the result would+-- overflow.+mul32 :: Int32 -> Int32 -> Int32+mul32 a b = case fromIntegral a * fromIntegral b of+              ab | ab < min32 || ab > max32 -> error "overflow"+                 | otherwise                -> fromIntegral ab+  where min32 = -0x80000000 :: Int64+        max32 =  0x7fffffff+{-# INLINE mul32 #-}+infixl 7 `mul32`+-}

@@ -0,0 +1,52 @@+{- | Conversion between 'Data.Text.Text' and 'Data.JSString.JSString'  -}++module Data.JSString.Text+    ( textToJSString+    , textFromJSString+    , lazyTextToJSString+    , lazyTextFromJSString+    , textFromJSVal+    , lazyTextFromJSVal+    ) where++import GHCJS.Prim.Internal (JSVal)++import Data.Coerce (coerce)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++import Data.JSString.Internal.Type++import Language.Javascript.JSaddle.Types (JSM, GHCJSPure(..))+import Language.Javascript.JSaddle.Native.Internal+       (valueToString)++textToJSString :: T.Text -> JSString+textToJSString = coerce+{-# INLINE textToJSString #-}++textFromJSString :: JSString -> T.Text+textFromJSString = coerce+{-# INLINE  textFromJSString #-}++lazyTextToJSString :: TL.Text -> JSString+lazyTextToJSString = coerce . TL.toStrict+{-# INLINE lazyTextToJSString #-}++lazyTextFromJSString :: JSString -> TL.Text+lazyTextFromJSString = TL.fromStrict . coerce+{-# INLINE lazyTextFromJSString #-}++-- | returns the empty Text if not a string+textFromJSVal :: JSVal -> GHCJSPure T.Text+textFromJSVal j = GHCJSPure $ textFromJSString <$> valToJSString j+{-# INLINE textFromJSVal #-}++-- | returns the empty Text if not a string+lazyTextFromJSVal :: JSVal -> GHCJSPure TL.Text+lazyTextFromJSVal j = GHCJSPure $ lazyTextFromJSString <$> valToJSString j+{-# INLINE lazyTextFromJSVal #-}++valToJSString :: JSVal -> JSM JSString+valToJSString = valueToString+{-# INLINE valToJSString #-}

@@ -0,0 +1,117 @@+module GHCJS.Buffer+    ( Buffer+    , MutableBuffer+    , create+    , createFromArrayBuffer+    , thaw, freeze, clone+      -- * JavaScript properties+    , byteLength+    , getArrayBuffer+    , getUint8Array+    , getUint16Array+    , getInt32Array+    , getDataView+    , getFloat32Array+    , getFloat64Array+      -- * bytestring+    , toByteString, fromByteString+    ) where++import GHCJS.Buffer.Types++import Control.Lens.Operators ((^.))++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64 as B64 (encode, decode)+import Data.Text.Encoding (encodeUtf8, decodeUtf8)++import qualified JavaScript.TypedArray.Internal.Types as I+import           JavaScript.TypedArray.ArrayBuffer.Internal (SomeArrayBuffer(..))+import           JavaScript.TypedArray.DataView.Internal    (SomeDataView(..))++import GHCJS.Marshal (FromJSVal(..))+import Language.Javascript.JSaddle.Types (JSM, GHCJSPure(..), ghcjsPure)+import Language.Javascript.JSaddle.Object (js, js2, jsg1, jsg3)++create :: Int -> JSM MutableBuffer+create n | n >= 0    = SomeBuffer <$> jsg1 "h$newByteArray" n+         | otherwise = error "create: negative size"+{-# INLINE create #-}++createFromArrayBuffer :: SomeArrayBuffer any -> GHCJSPure (SomeBuffer any)+createFromArrayBuffer (SomeArrayBuffer buf) = GHCJSPure $ SomeBuffer <$> jsg1 "h$wrapBuffer" buf+{-# INLINE createFromArrayBuffer #-}++getArrayBuffer :: SomeBuffer any -> GHCJSPure (SomeArrayBuffer any)+getArrayBuffer (SomeBuffer buf) = GHCJSPure $ SomeArrayBuffer <$> buf ^. js "buf"+{-# INLINE getArrayBuffer #-}++getInt32Array :: SomeBuffer any -> GHCJSPure (I.SomeInt32Array any)+getInt32Array (SomeBuffer buf) = GHCJSPure $ I.SomeTypedArray <$> buf ^. js "i3"+{-# INLINE getInt32Array #-}++getUint8Array :: SomeBuffer any -> GHCJSPure (I.SomeUint8Array any)+getUint8Array (SomeBuffer buf) = GHCJSPure $ I.SomeTypedArray <$> buf ^. js "u3"+{-# INLINE getUint8Array #-}++getUint16Array :: SomeBuffer any -> GHCJSPure (I.SomeUint16Array any)+getUint16Array (SomeBuffer buf) = GHCJSPure $ I.SomeTypedArray <$> buf ^. js "u1"+{-# INLINE getUint16Array #-}++getFloat32Array :: SomeBuffer any -> GHCJSPure (I.SomeFloat32Array any)+getFloat32Array (SomeBuffer buf) = GHCJSPure $ I.SomeTypedArray <$> buf ^. js "f3"+{-# INLINE getFloat32Array #-}++getFloat64Array :: SomeBuffer any -> GHCJSPure (I.SomeFloat64Array any)+getFloat64Array (SomeBuffer buf) = GHCJSPure $ I.SomeTypedArray <$> buf ^. js "f6"+{-# INLINE getFloat64Array #-}++getDataView :: SomeBuffer any -> GHCJSPure (SomeDataView any)+getDataView (SomeBuffer buf) = GHCJSPure $ SomeDataView  <$> buf ^. js "dv"+{-# INLINE getDataView #-}++freeze :: MutableBuffer -> JSM Buffer+freeze = js_clone+{-# INLINE freeze #-}++thaw :: Buffer -> JSM MutableBuffer+thaw  = js_clone+{-# INLINE thaw #-}++clone :: MutableBuffer -> JSM (SomeBuffer any2)+clone = js_clone+{-# INLINE clone #-}++fromByteString :: ByteString -> GHCJSPure (Buffer, Int, Int)+fromByteString bs = GHCJSPure $ do+  buffer <- SomeBuffer <$> jsg1 "h$newByteArrayBase64String" (decodeUtf8 $ B64.encode bs)+  return (buffer, 0, BS.length bs)+{-# INLINE fromByteString #-}++-- | Wrap a 'Buffer' into a 'ByteString' using the given offset+-- and length.+toByteString :: Int -> Maybe Int -> Buffer -> GHCJSPure ByteString+toByteString off mbLen buf = GHCJSPure $ do+  bufLen <- ghcjsPure $ byteLength buf+  case mbLen of+    _        | off < 0            -> error "toByteString: negative offset"+             | off > bufLen       -> error "toByteString: offset past end of buffer"+    Just len | len < 0            -> error "toByteString: negative length"+             | len > bufLen - off -> error "toByteString: length past end of buffer"+             | otherwise          -> ghcjsPure $ unsafeToByteString off len buf+    Nothing                       -> ghcjsPure $ unsafeToByteString off (bufLen - off) buf++unsafeToByteString :: Int -> Int -> Buffer -> GHCJSPure ByteString+unsafeToByteString off len (SomeBuffer buf) = GHCJSPure $ do+  b64 <- jsg3 "h$byteArrayToBase64String" off len buf >>= fromJSValUnchecked+  return $ case B64.decode (encodeUtf8 b64) of+            Left err -> error $ "unsafeToByteString base 64 decode error :" ++ err+            Right bs -> bs++byteLength :: SomeBuffer any -> GHCJSPure Int+byteLength (SomeBuffer buf) = GHCJSPure $ buf ^. js "len" >>= fromJSValUnchecked+{-# INLINE byteLength #-}++js_clone :: SomeBuffer any1 -> JSM (SomeBuffer any2)+js_clone (SomeBuffer buf) = SomeBuffer <$> jsg1 "h$wrapBuffer" (buf ^. js "buf" ^. js2 "slice" (buf ^. js "u8" ^. js "byteOffset") (buf ^. js "len"))

@@ -0,0 +1,11 @@+{-# LANGUAGE DataKinds, KindSignatures, PolyKinds #-}++module GHCJS.Buffer.Types where++import GHCJS.Types+import GHCJS.Internal.Types++newtype SomeBuffer (a :: MutabilityType s) = SomeBuffer JSVal++type    Buffer         = SomeBuffer Immutable+type    MutableBuffer  = SomeBuffer Mutable

@@ -0,0 +1,64 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+--+-- Module      :  Language.Javascript.JSaddle.Value+-- Copyright   :  (c) Hamish Mackenzie+-- License     :  MIT+--+-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- |+--+-----------------------------------------------------------------------------+module GHCJS.Foreign (+    jsTrue+  , jsFalse+  , jsNull+  , toJSBool+--  , fromJSBool+  , jsUndefined+  , isTruthy+  , isNull+  , isUndefined+  , isObject+  , isFunction+  , isString+  , isBoolean+  , isSymbol+  , isNumber+  , JSType(..)+  , jsTypeOf+) where++import GHCJS.Foreign.Internal+import Language.Javascript.JSaddle.Types (JSVal(..), GHCJSPure(..))+import Language.Javascript.JSaddle.Object (jsg1)+import GHCJS.Marshal (FromJSVal(..))++isObject :: JSVal -> GHCJSPure Bool+isObject v = GHCJSPure $ jsg1 "h$isObject" v >>= fromJSValUnchecked+{-# INLINE isObject #-}++isFunction :: JSVal -> GHCJSPure Bool+isFunction v = GHCJSPure $ jsg1 "h$isFunction" v >>= fromJSValUnchecked+{-# INLINE isFunction #-}++isString :: JSVal -> GHCJSPure Bool+isString v = GHCJSPure $ jsg1 "h$isString" v >>= fromJSValUnchecked+{-# INLINE isString #-}++isBoolean :: JSVal -> GHCJSPure Bool+isBoolean v = GHCJSPure $ jsg1 "h$isBoolean" v >>= fromJSValUnchecked+{-# INLINE isBoolean #-}++isSymbol :: JSVal -> GHCJSPure Bool+isSymbol v = GHCJSPure $ jsg1 "h$isSymbol" v >>= fromJSValUnchecked+{-# INLINE isSymbol #-}++isNumber :: JSVal -> GHCJSPure Bool+isNumber v = GHCJSPure $ jsg1 "h$isNumber" v >>= fromJSValUnchecked+{-# INLINE isNumber #-}++jsTypeOf :: JSVal -> GHCJSPure JSType+jsTypeOf v = GHCJSPure $ toEnum <$> (jsg1 "h$jsonTypeOf" v >>= fromJSValUnchecked)+{-# INLINE jsTypeOf #-}

@@ -0,0 +1,65 @@+-----------------------------------------------------------------------------+--+-- Module      :  Language.Javascript.JSaddle.Value+-- Copyright   :  (c) Hamish Mackenzie+-- License     :  MIT+--+-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- |+--+-----------------------------------------------------------------------------+module GHCJS.Foreign.Internal (+    jsTrue+  , jsFalse+  , jsNull+  , toJSBool+--  , fromJSBool+  , jsUndefined+  , isTruthy+  , isNull+  , isUndefined+  , JSType(..)+) where++import Language.Javascript.JSaddle.Types (JSVal(..), GHCJSPure(..))+import Language.Javascript.JSaddle.Native.Internal+       (valueToBool)+import Data.Typeable (Typeable)+import GHCJS.Prim (isNull, isUndefined)++jsTrue :: JSVal+jsTrue = JSVal 3+{-# INLINE jsTrue #-}++jsFalse :: JSVal+jsFalse = JSVal 2+{-# INLINE jsFalse #-}++jsNull :: JSVal+jsNull = JSVal 0+{-# INLINE jsNull #-}++toJSBool :: Bool -> JSVal+toJSBool b = JSVal $ if b then 3 else 2+{-# INLINE toJSBool #-}++jsUndefined :: JSVal+jsUndefined = JSVal 1+{-# INLINE jsUndefined #-}++isTruthy :: JSVal -> GHCJSPure Bool+isTruthy = GHCJSPure . valueToBool+{-# INLINE isTruthy #-}++-- types returned by JS typeof operator+data JSType = Undefined+            | Object+            | Boolean+            | Number+            | String+            | Symbol+            | Function+            | Other    -- ^ implementation dependent+            deriving (Show, Eq, Ord, Enum, Typeable)+

@@ -0,0 +1,16 @@+module GHCJS.Internal.Types ( IsJSVal(..)+                            , jsval+                            , MutabilityType(..)+                            , Mutable+                            , Immutable+                            , IsItMutable(..)+                            , Mutability+                            ) where++import Language.Javascript.JSaddle.Types+import Language.Javascript.JSaddle.Native.Internal (stringToValue)++instance IsJSVal JSString where+  jsval_ a = GHCJSPure $ stringToValue a+  {-# INLINE jsval_ #-}+

@@ -17,20 +17,24 @@  import qualified Data.Aeson as AE import           Data.Int (Int8, Int16, Int32)+import           Data.Text (Text) import           Data.Word (Word8, Word16, Word32, Word)  import           GHC.Prim -import           Language.Javascript.JSaddle.Types (JSM, JSVal, SomeJSArray(..), Command(ValueToJSONValue), Result(ValueToJSONValueResult))-import           Language.Javascript.JSaddle.Native (withToJSVal)-import           Language.Javascript.JSaddle.Run(sendCommand)-import           GHCJS.Marshal.Internal+import           Language.Javascript.JSaddle.Types (JSM, JSVal, SomeJSArray(..), ghcjsPure)+import           Language.Javascript.JSaddle.Native.Internal+                 (valueToJSONValue, jsonValueToValue, valueToNumber)++import           GHCJS.Types (JSString, isUndefined, isNull)+import           GHCJS.Foreign.Internal (isTruthy) import           GHCJS.Marshal.Pure ()-import           Language.Javascript.JSaddle.Value (isUndefinedIO, valToNumber,-                                                    valToBool, valMakeJSON)-import           Language.Javascript.JSaddle.Array (fromListIO)-import qualified Language.Javascript.JSaddle.Array as A (read) +import           JavaScript.Array (fromListIO)+import qualified JavaScript.Array as A (read)++import           GHCJS.Marshal.Internal+ instance FromJSVal JSVal where   fromJSValUnchecked x = return x   {-# INLINE fromJSValUnchecked #-}@@ -42,65 +46,62 @@   fromJSVal = fromJSVal_pure --    {-# INLINE fromJSVal #-} instance FromJSVal Bool where-    fromJSValUnchecked = valToBool+    fromJSValUnchecked = ghcjsPure . isTruthy     {-# INLINE fromJSValUnchecked #-}-    fromJSVal = fmap Just . valToBool+    fromJSVal = fmap Just . ghcjsPure . isTruthy     {-# INLINE fromJSVal #-} instance FromJSVal Int where-    fromJSValUnchecked = fmap round . valToNumber+    fromJSValUnchecked = fmap round . valueToNumber     {-# INLINE fromJSValUnchecked #-}-    fromJSVal = fmap (Just . round) . valToNumber+    fromJSVal = fmap (Just . round) . valueToNumber     {-# INLINE fromJSVal #-} instance FromJSVal Int8 where-    fromJSValUnchecked = fmap round . valToNumber+    fromJSValUnchecked = fmap round . valueToNumber     {-# INLINE fromJSValUnchecked #-}-    fromJSVal = fmap (Just . round) . valToNumber+    fromJSVal = fmap (Just . round) . valueToNumber     {-# INLINE fromJSVal #-} instance FromJSVal Int16 where-    fromJSValUnchecked = fmap round . valToNumber+    fromJSValUnchecked = fmap round . valueToNumber     {-# INLINE fromJSValUnchecked #-}-    fromJSVal = fmap (Just . round) . valToNumber+    fromJSVal = fmap (Just . round) . valueToNumber     {-# INLINE fromJSVal #-} instance FromJSVal Int32 where-    fromJSValUnchecked = fmap round . valToNumber+    fromJSValUnchecked = fmap round . valueToNumber     {-# INLINE fromJSValUnchecked #-}-    fromJSVal = fmap (Just . round) . valToNumber+    fromJSVal = fmap (Just . round) . valueToNumber     {-# INLINE fromJSVal #-} instance FromJSVal Word where-    fromJSValUnchecked = fmap round . valToNumber+    fromJSValUnchecked = fmap round . valueToNumber     {-# INLINE fromJSValUnchecked #-}-    fromJSVal = fmap (Just . round) . valToNumber+    fromJSVal = fmap (Just . round) . valueToNumber     {-# INLINE fromJSVal #-} instance FromJSVal Word8 where-    fromJSValUnchecked = fmap round . valToNumber+    fromJSValUnchecked = fmap round . valueToNumber     {-# INLINE fromJSValUnchecked #-}-    fromJSVal = fmap (Just . round) . valToNumber+    fromJSVal = fmap (Just . round) . valueToNumber     {-# INLINE fromJSVal #-} instance FromJSVal Word16 where-    fromJSValUnchecked = fmap round . valToNumber+    fromJSValUnchecked = fmap round . valueToNumber     {-# INLINE fromJSValUnchecked #-}-    fromJSVal = fmap (Just . round) . valToNumber+    fromJSVal = fmap (Just . round) . valueToNumber     {-# INLINE fromJSVal #-} instance FromJSVal Word32 where-    fromJSValUnchecked = fmap round . valToNumber+    fromJSValUnchecked = fmap round . valueToNumber     {-# INLINE fromJSValUnchecked #-}-    fromJSVal = fmap (Just . round) . valToNumber+    fromJSVal = fmap (Just . round) . valueToNumber     {-# INLINE fromJSVal #-} instance FromJSVal Float where-    fromJSValUnchecked = fmap realToFrac . valToNumber+    fromJSValUnchecked = fmap realToFrac . valueToNumber     {-# INLINE fromJSValUnchecked #-}-    fromJSVal = fmap (Just . realToFrac) . valToNumber+    fromJSVal = fmap (Just . realToFrac) . valueToNumber     {-# INLINE fromJSVal #-} instance FromJSVal Double where-    fromJSValUnchecked = valToNumber+    fromJSValUnchecked = valueToNumber     {-# INLINE fromJSValUnchecked #-}-    fromJSVal = fmap Just . valToNumber+    fromJSVal = fmap Just . valueToNumber     {-# INLINE fromJSVal #-} instance FromJSVal AE.Value where-    fromJSVal r =-        withToJSVal r $ \rval -> do-            ValueToJSONValueResult result <- sendCommand (ValueToJSONValue rval)-            return $ Just result+    fromJSVal r = Just <$> valueToJSONValue r     {-# INLINE fromJSVal #-} instance (FromJSVal a, FromJSVal b) => FromJSVal (a,b) where     fromJSVal r = runMaybeT $ (,) <$> jf r 0 <*> jf r 1@@ -127,7 +128,7 @@ jf :: FromJSVal a => JSVal -> Int -> MaybeT JSM a jf r n = MaybeT $ do   r' <- A.read n (SomeJSArray r)-  isUndefinedIO r >>= \case+  ghcjsPure (isUndefined r) >>= \case     True -> return Nothing     False -> fromJSVal r' @@ -164,5 +165,5 @@ arr7 a b c d e f g = coerce <$> fromListIO [a,b,c,d,e,f,g]  toJSVal_aeson :: AE.ToJSON a => a -> JSM JSVal-toJSVal_aeson = valMakeJSON . AE.toJSON+toJSVal_aeson = jsonValueToValue . AE.toJSON 

@@ -3,19 +3,19 @@              LambdaCase   #-} -module GHCJS.Marshal.Internal (-        FromJSVal(..)-      , ToJSVal(..)-      , PToJSVal(..)-      , PFromJSVal(..)-      , Purity(..)-      , toJSVal_generic-      , fromJSVal_generic-      , toJSVal_pure-      , fromJSVal_pure-      , fromJSValUnchecked_pure-      ) where+module GHCJS.Marshal.Internal ( FromJSVal(..)+                              , ToJSVal(..)+                              , PToJSVal(..)+                              , PFromJSVal(..)+                              , Purity(..)+                              , toJSVal_generic+                              , fromJSVal_generic+                              , toJSVal_pure+                              , fromJSVal_pure+                              , fromJSValUnchecked_pure+                              ) where +import           Control.Applicative import           Control.Monad  import           Data.Data@@ -25,12 +25,18 @@  import           GHC.Generics -import           Language.Javascript.JSaddle.Types (JSM, JSVal, SomeJSArray(..), MutableJSArray, JSString)-import           Language.Javascript.JSaddle.Foreign (jsNull, jsTrue, isUndefinedIO)-import           Language.Javascript.JSaddle.String (textToStr)+import qualified GHCJS.Prim.Internal        as Prim+import qualified GHCJS.Foreign.Internal     as F+import           GHCJS.Types++import qualified Data.JSString.Internal.Type as JSS+ import qualified JavaScript.Object.Internal as OI (Object(..), create, setProp, getProp)-import qualified JavaScript.Array.Internal as AI (create, push, read, fromListIO, toListIO)+import qualified JavaScript.Array.Internal as AI (SomeJSArray(..), create, push, read, fromListIO, toListIO) +import           Language.Javascript.JSaddle.Types (JSM, MutableJSArray, GHCJSPure(..), ghcjsPure, ghcjsPureMap)+import           Language.Javascript.JSaddle.String (textToStr)+ data Purity = PureShared    -- ^ conversion is pure even if the original value is shared             | PureExclusive -- ^ conversion is pure if the we only convert once   deriving (Eq, Ord, Typeable, Data)@@ -49,6 +55,9 @@   toJSValListOf :: [a] -> JSM JSVal   toJSValListOf = fmap coerce . AI.fromListIO <=< mapM toJSVal +  -- default toJSVal :: PToJSVal a => a -> JSM (JSVal a)+  -- toJSVal x = return (pToJSVal x)+   default toJSVal :: (Generic a, GToJSVal (Rep a ())) => a -> JSM JSVal   toJSVal = toJSVal_generic id @@ -65,9 +74,15 @@   fromJSValUncheckedListOf :: JSVal -> JSM [a]   fromJSValUncheckedListOf = mapM fromJSValUnchecked <=< AI.toListIO . coerce +  -- default fromJSVal :: PFromJSVal a => JSVal a -> JSM (Maybe a)+  -- fromJSVal x = return (Just (pFromJSVal x))+   default fromJSVal :: (Generic a, GFromJSVal (Rep a ())) => JSVal -> JSM (Maybe a)   fromJSVal = fromJSVal_generic id +  -- default fromJSValUnchecked :: PFromJSVal a => a -> IO a+  -- fromJSValUnchecked x = return (pFromJSVal x)+ -- -----------------------------------------------------------------------------  class GToJSVal a where@@ -92,8 +107,8 @@   gToJSVal f _ (L1 x) = gToJSVal f True x   gToJSVal f _ (R1 x) = gToJSVal f True x -instance (GToJSVal (a p)) => GToJSVal (M1 D c a p) where-  gToJSVal f b (M1 x) = gToJSVal f b x+instance (Datatype c, GToJSVal (a p)) => GToJSVal (M1 D c a p) where+  gToJSVal f b m@(M1 x) = gToJSVal f b x  instance (Constructor c, GToJSVal (a p)) => GToJSVal (M1 C c a p) where   gToJSVal f True m@(M1 x) = do@@ -109,7 +124,7 @@     gToJSProp f obj' xy     return obj'   gToJSVal f False xy = do-    arr@(SomeJSArray arr') <- AI.create+    arr@(AI.SomeJSArray arr') <- AI.create     gToJSArr f arr xy     return arr' @@ -133,10 +148,10 @@     AI.push r a  instance GToJSVal (V1 p) where-  gToJSVal _ _ _ = return jsNull+  gToJSVal _ _ _ = return Prim.jsNull  instance GToJSVal (U1 p) where-  gToJSVal _ _ _ = return jsTrue+  gToJSVal _ _ _ = return F.jsTrue  toJSVal_generic :: forall a . (Generic a, GToJSVal (Rep a ()))                 => (String -> String) -> a -> JSM JSVal@@ -163,26 +178,26 @@   gFromJSVal f b r = gFromJSVal f b r  instance (GFromJSVal (a p), GFromJSVal (b p)) => GFromJSVal ((a :+: b) p) where-  gFromJSVal f _b r = do+  gFromJSVal f b r = do     l <- gFromJSVal f True r     case l of       Just x  -> return (L1 <$> Just x)       Nothing -> fmap R1 <$> gFromJSVal f True r -instance GFromJSVal (a p) => GFromJSVal (M1 D c a p) where+instance (Datatype c, GFromJSVal (a p)) => GFromJSVal (M1 D c a p) where   gFromJSVal f b r = fmap M1 <$> gFromJSVal f b r  instance forall c a p . (Constructor c, GFromJSVal (a p)) => GFromJSVal (M1 C c a p) where   gFromJSVal f True r = do     r' <- OI.getProp (packJSS . f $ conName (undefined :: M1 C c a p)) (OI.Object r)-    isUndefinedIO r' >>= \case+    ghcjsPure (isUndefined r') >>= \case       True -> return Nothing       False -> fmap M1 <$> gFromJSVal f (conIsRecord (undefined :: M1 C c a p)) r'   gFromJSVal f _ r = fmap M1 <$> gFromJSVal f (conIsRecord (undefined :: M1 C c a p)) r  instance (GFromJSArr (a p), GFromJSArr (b p), GFromJSProp (a p), GFromJSProp (b p)) => GFromJSVal ((a :*: b) p) where   gFromJSVal f True  r = gFromJSProp f r-  gFromJSVal f False r = fmap fst <$> gFromJSArr f (SomeJSArray r) 0+  gFromJSVal f False r = fmap fst <$> gFromJSArr f (AI.SomeJSArray r) 0  instance GFromJSVal (a p) => GFromJSVal (M1 S c a p) where   gFromJSVal f b r = fmap M1 <$> gFromJSVal f b r@@ -197,7 +212,7 @@ instance forall c a p . (Selector c, GFromJSVal (a p)) => GFromJSProp (M1 S c a p) where   gFromJSProp f o = do     p <- OI.getProp (packJSS . f $ selName (undefined :: M1 S c a p)) (OI.Object o)-    isUndefinedIO p >>= \case+    ghcjsPure (isUndefined p) >>= \case       True -> return Nothing       False -> fmap M1 <$> gFromJSVal f False p @@ -214,7 +229,7 @@ instance (GFromJSVal (a p)) => GFromJSArr (M1 S c a p) where   gFromJSArr f o n = do     r <- AI.read n o-    isUndefinedIO r >>= \case+    ghcjsPure (isUndefined r) >>= \case       True -> return Nothing       False -> fmap ((,n+1) . M1) <$> gFromJSVal f False r @@ -231,15 +246,15 @@ -- -----------------------------------------------------------------------------  fromJSVal_pure :: PFromJSVal a => JSVal -> JSM (Maybe a)-fromJSVal_pure x = return (Just (pFromJSVal x))+fromJSVal_pure = return . Just . pFromJSVal {-# INLINE fromJSVal_pure #-}  fromJSValUnchecked_pure :: PFromJSVal a => JSVal -> JSM a-fromJSValUnchecked_pure x = return (pFromJSVal x)+fromJSValUnchecked_pure = return . pFromJSVal {-# INLINE fromJSValUnchecked_pure #-}  toJSVal_pure :: PToJSVal a => a -> JSM JSVal-toJSVal_pure x = return (pToJSVal x)+toJSVal_pure = return . pToJSVal {-# INLINE toJSVal_pure #-}  -- -----------------------------------------------------------------------------

@@ -1,12 +1,11 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-module GHCJS.Marshal.Pure-  ( PFromJSVal(..)-  , PToJSVal(..)-  ) where+module GHCJS.Marshal.Pure ( PFromJSVal(..)+                          , PToJSVal(..)+                          ) where +import           GHCJS.Types+import           GHCJS.Foreign.Internal (jsFalse, jsTrue) import           GHCJS.Marshal.Internal-import           Language.Javascript.JSaddle.Types (JSVal(..))-import           Language.Javascript.JSaddle.Foreign (jsFalse, jsTrue)  instance PFromJSVal JSVal where pFromJSVal = id                                 {-# INLINE pFromJSVal #-}

@@ -0,0 +1,84 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module GHCJS.Prim ( module GHCJS.Prim.Internal+                  , fromJSString+                  , toJSString+                  , isNull+                  , isUndefined+                  ) where++import           GHCJS.Prim.Internal+--import           Data.Int (Int64)+--import           Data.Typeable (Typeable)+--import           Unsafe.Coerce (unsafeCoerce)++--import           Data.Aeson (ToJSON(..), FromJSON(..))+import qualified Data.Text as T (unpack, pack)+import           Data.JSString.Text (textFromJSVal)++--import           GHC.Prim+--import qualified GHC.Exception as Ex+--import qualified GHC.Exts as Exts++import Language.Javascript.JSaddle.Types (JSVal(..), JSString(..), GHCJSPure(..), ghcjsPureMap)+import qualified Language.Javascript.JSaddle.Native.Internal as N+       (stringToValue, isNull, isUndefined)+{- | Low-level conversion utilities for packages that cannot+     depend on ghcjs-base+ -}++fromJSString :: JSVal -> GHCJSPure String+fromJSString = ghcjsPureMap T.unpack . textFromJSVal+{-# INLINE fromJSString #-}++toJSString :: String -> GHCJSPure JSVal+toJSString s = GHCJSPure $ N.stringToValue (JSString $ T.pack s)+{-# INLINE toJSString #-}++--fromJSArray :: JSVal -> IO [JSVal]+--fromJSArray = unsafeCoerce . js_fromJSArray+--{-# INLINE fromJSArray #-}+--+--toJSArray :: [JSVal] -> IO JSVal+--toJSArray = js_toJSArray . unsafeCoerce . seqList+--{-# INLINE toJSArray #-}+--+--{- | returns zero if the JSVal does not contain a number+-- -}+--fromJSInt :: JSVal -> Int+--fromJSInt = js_fromJSInt+--{-# INLINE fromJSInt #-}+--+--toJSInt :: Int -> JSVal+--toJSInt = js_toJSInt+--{-# INLINE toJSInt #-}+--++isNull :: JSVal -> GHCJSPure Bool+isNull = GHCJSPure . N.isNull+{-# INLINE isNull #-}++isUndefined :: JSVal -> GHCJSPure Bool+isUndefined = GHCJSPure . N.isUndefined+{-# INLINE isUndefined #-}++--getProp :: JSVal -> String -> IO JSVal+--getProp o p = js_getProp o (unsafeCoerce $ seqList p)+--{-# INLINE getProp #-}+--+--getProp' :: JSVal -> JSVal -> IO JSVal+--getProp' o p = js_getProp' o p+--{-# INLINE getProp' #-}+--+---- reduce the spine and all list elements to whnf+--seqList :: [a] -> [a]+--seqList xs = go xs `seq` xs+--  where go (x:xs) = x `seq` go xs+--        go []     = ()+--+--seqListSpine :: [a] -> [a]+--seqListSpine xs = go xs `seq` xs+--  where go (x:xs) = go xs+--        go []     = ()

@@ -0,0 +1,66 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module GHCJS.Prim.Internal ( JSVal(..)+                           , JSValueRef+                           , JSException(..)+                           , WouldBlockException(..)+                           , mkJSException+                           , jsNull+                           ) where++import           Control.DeepSeq (NFData(..))+import           Data.Int (Int64)+import           Data.Typeable (Typeable)+import           Unsafe.Coerce (unsafeCoerce)++import           Data.Aeson (ToJSON(..), FromJSON(..))++import qualified GHC.Exception as Ex++-- A reference to a particular JavaScript value inside the JavaScript context+type JSValueRef = Int64++{-+  JSVal is a boxed type that can be used as FFI+  argument or result.+-}+newtype JSVal = JSVal JSValueRef deriving(Show, ToJSON, FromJSON)++instance NFData JSVal where+  rnf x = x `seq` ()+++{-+  When a JavaScript exception is raised inside+  a safe or interruptible foreign call, it is converted+  to a JSException+ -}+data JSException = JSException JSVal String+  deriving (Typeable)++instance Ex.Exception JSException++instance Show JSException where+  show (JSException _ xs) = "JavaScript exception: " ++ xs++mkJSException :: JSVal -> IO JSException+mkJSException ref =+  return (JSException (unsafeCoerce ref) "")++jsNull :: JSVal+jsNull = JSVal 0+{-# INLINE jsNull #-}++{- | If a synchronous thread tries to do something that can only+     be done asynchronously, and the thread is set up to not+     continue asynchronously, it receives this exception.+ -}+data WouldBlockException = WouldBlockException+  deriving (Typeable)++instance Show WouldBlockException where+  show _ = "thread would block"++instance Ex.Exception WouldBlockException+

@@ -0,0 +1,58 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE BangPatterns #-}++module GHCJS.Types ( JSVal+                   , WouldBlockException(..)+                   , JSException(..)+                   , IsJSVal+                   , jsval+                   , isNull+                   , isUndefined+                   , nullRef+                   , JSString+                   , mkRef+                   , Ref#+--                   , toPtr+--                   , fromPtr+                   , JSRef+                   ) where++import Data.JSString.Internal.Type (JSString)+import GHCJS.Internal.Types++import GHCJS.Prim++import GHC.Int+import GHC.Types+import GHC.Prim+import GHC.Ptr++import Control.DeepSeq+import Unsafe.Coerce++type Ref# = Int64++mkRef :: Ref# -> JSVal+mkRef = JSVal+{-# INLINE mkRef #-}++nullRef :: JSVal+nullRef = JSVal 0+{-# INLINE nullRef #-}++--toPtr :: JSVal -> Ptr a+--toPtr (JSVal x) = unsafeCoerce (Ptr' x 0#)+--{-# INLINE toPtr #-}+--+--fromPtr :: Ptr a -> JSVal+--fromPtr p = js_ptrVal p+--{-# INLINE fromPtr #-}+--+--data Ptr' a = Ptr' ByteArray# Int#++-- | This is a deprecated copmatibility wrapper for the old JSRef type.+--+-- See https://github.com/ghcjs/ghcjs/issues/421+type JSRef a = JSVal+{-# DEPRECATED JSRef "Use JSVal instead, or a more specific newtype wrapper of JSVal " #-}

@@ -0,0 +1,134 @@+-----------------------------------------------------------------------------+--+-- Module      :  JavaScript.Array+-- Copyright   :  (c) Hamish Mackenzie+-- License     :  MIT+--+-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | Interface to JavaScript array+--+-----------------------------------------------------------------------------+module JavaScript.Array+    ( SomeJSArray(..)+    , JSArray+    , MutableJSArray+    , create+    , length+    , lengthIO+    , null+    , fromList+    , fromListIO+    , toList+    , toListIO+    , index, (!)+    , read+    , write+    , append+    , push+    , pop+    , unshift+    , shift+    , reverse+    , take+    , takeIO+    , drop+    , dropIO+    , slice+    , sliceIO+    , freeze+    , unsafeFreeze+    , thaw+    , unsafeThaw+    ) where++import Prelude hiding (length, drop, read, take, reverse, null)+import Control.Monad (void)+import Language.Javascript.JSaddle.Types+       (JSM, JSVal, SomeJSArray(..), JSArray,+        MutableJSArray, GHCJSPure(..))+import Control.Lens.Operators ((^.))+import Language.Javascript.JSaddle.Object (js2, js0, (##), js1, js)+import Language.Javascript.JSaddle.Value (valToNumber)+import JavaScript.Array.Internal (create, fromList, fromListIO, toList, toListIO, index, read, push)++length :: SomeJSArray m -> GHCJSPure Int+length = GHCJSPure . lengthIO+{-# INLINE length #-}++lengthIO :: SomeJSArray m -> JSM Int+lengthIO (SomeJSArray x) = round <$> (x ^. js "length" >>= valToNumber)+{-# INLINE lengthIO #-}++null :: SomeJSArray m -> GHCJSPure Bool+null = GHCJSPure . fmap (== 0) . lengthIO+{-# INLINE null #-}++append :: SomeJSArray m -> SomeJSArray m -> JSM (SomeJSArray m1)+append (SomeJSArray x) (SomeJSArray y) = SomeJSArray <$> x ^. js1 "concat" y+{-# INLINE append #-}++write :: Int -> JSVal -> MutableJSArray -> JSM ()+write n e (SomeJSArray x) = void $ (x ## n) e+{-# INLINE write #-}++pop :: MutableJSArray -> JSM JSVal+pop (SomeJSArray x) = x ^. js0 "pop"+{-# INLINE pop #-}++unshift :: JSVal -> MutableJSArray -> JSM ()+unshift e (SomeJSArray x) = void $ x ^. js1 "unshift" e+{-# INLINE unshift #-}++shift :: MutableJSArray -> JSM JSVal+shift (SomeJSArray x) = x ^. js0 "shift"+{-# INLINE shift #-}++reverse :: MutableJSArray -> JSM ()+reverse (SomeJSArray x) = void $ x ^. js0 "reverse"+{-# INLINE reverse #-}++take :: Int -> SomeJSArray m -> GHCJSPure (SomeJSArray m1)+take n = GHCJSPure . takeIO n+{-# INLINE take #-}++takeIO :: Int -> SomeJSArray m -> JSM (SomeJSArray m1)+takeIO n (SomeJSArray x) = SomeJSArray <$> x ^. js2 "slice" (0::Int) n+{-# INLINE takeIO #-}++drop :: Int -> SomeJSArray m -> GHCJSPure (SomeJSArray m1)+drop n = GHCJSPure . dropIO n+{-# INLINE drop #-}++dropIO :: Int -> SomeJSArray m -> JSM (SomeJSArray m1)+dropIO n (SomeJSArray x) = SomeJSArray <$> x ^. js1 "slice1" n+{-# INLINE dropIO #-}++slice :: Int -> Int -> JSArray -> GHCJSPure (SomeJSArray m1)+slice s n = GHCJSPure . sliceIO s n+{-# INLINE slice #-}++sliceIO :: Int -> Int -> JSArray -> JSM (SomeJSArray m1)+sliceIO s n (SomeJSArray x) = SomeJSArray <$> x ^. js2 "slice" s n+{-# INLINE sliceIO #-}++freeze :: MutableJSArray -> JSM JSArray+freeze (SomeJSArray x) = SomeJSArray <$> x ^. js1 "slice" (0::Int)+{-# INLINE freeze #-}++unsafeFreeze :: MutableJSArray -> JSM JSArray+unsafeFreeze (SomeJSArray x) = pure (SomeJSArray x)+{-# INLINE unsafeFreeze #-}++thaw :: JSArray -> JSM MutableJSArray+thaw (SomeJSArray x) = SomeJSArray <$> x ^. js1 "slice" (0::Int)+{-# INLINE thaw #-}++unsafeThaw :: JSArray -> JSM MutableJSArray+unsafeThaw (SomeJSArray x) = pure (SomeJSArray x)+{-# INLINE unsafeThaw #-}++(!) :: JSArray -> Int -> GHCJSPure JSVal+x ! n = GHCJSPure $ read n x+{-# INLINE (!) #-}+

@@ -1,46 +1,61 @@ {-# LANGUAGE OverloadedStrings #-} module JavaScript.Array.Internal-    ( create+    ( SomeJSArray(..)+    , JSArray+    , MutableJSArray+    , STJSArray+    , create+    , fromList     , fromListIO+    , toList     , toListIO+    , index     , read     , push     ) where  import Prelude hiding(read) import Control.Monad (void)-import Language.Javascript.JSaddle.Types (JSM, JSVal, SomeJSArray(..), MutableJSArray, Object(..), JSString(..))+import GHCJS.Types (JSVal)+import Data.JSString.Internal.Type (JSString(..))+import Language.Javascript.JSaddle.Types (JSM, SomeJSArray(..), JSArray, MutableJSArray, STJSArray, Object(..), GHCJSPure(..)) import Language.Javascript.JSaddle.Native.Internal-       (withObject, withJSVal, withJSString, withJSVals)+       (newArray, getPropertyByName, getPropertyAtIndex, callAsFunction, valueToNumber) import Language.Javascript.JSaddle.Run        (Command(..), Result(..), AsyncCommand(..), sendCommand, sendLazyCommand)  create :: JSM MutableJSArray-create = SomeJSArray <$> sendLazyCommand (NewArray [])+create = SomeJSArray <$> newArray [] {-# INLINE create #-} +fromList :: [JSVal] -> GHCJSPure (SomeJSArray m)+fromList = GHCJSPure . fromListIO+{-# INLINE fromList #-}+ fromListIO :: [JSVal] -> JSM (SomeJSArray m)-fromListIO xs = withJSVals xs $ \xs' -> SomeJSArray <$> sendLazyCommand (NewArray xs')+fromListIO xs = SomeJSArray <$> newArray xs {-# INLINE fromListIO #-} +toList :: SomeJSArray m -> GHCJSPure [JSVal]+toList = GHCJSPure . toListIO+{-# INLINE toList #-}+ toListIO :: SomeJSArray m -> JSM [JSVal]-toListIO (SomeJSArray x) =-    withObject (Object x) $ \this -> do-        l <- withJSString (JSString "length") $ sendLazyCommand . GetPropertyByName this-        withJSVal l $ \l' -> do-            ValueToNumberResult len <- sendCommand (ValueToNumber l')-            mapM (sendLazyCommand . GetPropertyAtIndex this) [0..round len - 1]+toListIO (SomeJSArray x) = do+    len <- getPropertyByName (JSString "length") (Object x) >>= valueToNumber+    mapM (`getPropertyAtIndex` Object x) [0..round len - 1] {-# INLINE toListIO #-} +index :: Int -> SomeJSArray m -> GHCJSPure JSVal+index n = GHCJSPure . read n+{-# INLINE index #-}+ read :: Int -> SomeJSArray m -> JSM JSVal-read n (SomeJSArray x) =-    withObject (Object x) $ \this -> sendLazyCommand $ GetPropertyAtIndex this n+read n (SomeJSArray x) = getPropertyAtIndex n $ Object x {-# INLINE read #-}  push :: JSVal -> MutableJSArray -> JSM ()-push e (SomeJSArray x) =-    void $ withJSVal e $ \e' ->-        withObject (Object x) $ \this -> do-            f <- withJSString (JSString "push") $ sendLazyCommand . GetPropertyByName this-            withObject (Object f) $ \f' -> sendLazyCommand $ CallAsFunction f' this [e']+push e (SomeJSArray x) = void $ do+    f <- getPropertyByName (JSString "push") (Object x)+    void $ callAsFunction (Object f) (Object x) [e] {-# INLINE push #-}

@@ -0,0 +1,10 @@+module JavaScript.Object ( Object+                         , create+                         , getProp, unsafeGetProp+                         , setProp, unsafeSetProp+                         -- , allProps+                         , listProps+                         -- , isInstanceOf+                         ) where++import JavaScript.Object.Internal

@@ -7,43 +7,47 @@     , unsafeGetProp     , setProp     , unsafeSetProp---    , isInstanceOfIO+--    , isInstanceOf     ) where  import Language.Javascript.JSaddle.Types (JSM, JSVal, Object(..), JSString) import Language.Javascript.JSaddle.Native.Internal-       (withObject, withJSString, withJSVal, wrapJSString)-import Language.Javascript.JSaddle.Run-       (Command(..), AsyncCommand(..), Result(..), sendCommand, sendLazyCommand, sendAsyncCommand)+       (newEmptyObject, propertyNames, getPropertyByName, setPropertyByName) +-- | create an empty object create :: JSM Object-create = Object <$> sendLazyCommand NewEmptyObject+create = newEmptyObject+{-# INLINE create #-} +--allProps :: Object -> JSM JSArray+--allProps o = js_allProps o+--{-# INLINE allProps #-}+ listProps :: Object -> JSM [JSString]-listProps this =-    withObject this $ \rthis -> do-        PropertyNamesResult result <- sendCommand $ PropertyNames rthis-        mapM wrapJSString result+listProps = propertyNames {-# INLINE listProps #-} -unsafeGetProp :: JSString -> Object -> JSM JSVal-unsafeGetProp name this =-    withObject this $ \rthis ->-        withJSString name $ sendLazyCommand . GetPropertyByName rthis-{-# INLINE unsafeGetProp #-}-+{- | get a property from an object. If accessing the property results in+     an exception, the exception is converted to a JSException. Since exception+     handling code prevents some optimizations in some JS engines, you may want+     to use unsafeGetProp instead+ -} getProp :: JSString -> Object -> JSM JSVal getProp = unsafeGetProp {-# INLINE getProp #-} -unsafeSetProp :: JSString -> JSVal -> Object -> JSM ()-unsafeSetProp name val this =-    withObject this $ \rthis ->-        withJSString name $ \rname ->-            withJSVal val $ \rval ->-                sendAsyncCommand $ SetPropertyByName rthis rname rval-{-# INLINE unsafeSetProp #-}+unsafeGetProp :: JSString -> Object -> JSM JSVal+unsafeGetProp = getPropertyByName+{-# INLINE unsafeGetProp #-}  setProp :: JSString -> JSVal -> Object -> JSM () setProp = unsafeSetProp {-# INLINE setProp #-}++unsafeSetProp :: JSString -> JSVal -> Object -> JSM ()+unsafeSetProp = setPropertyByName+{-# INLINE unsafeSetProp #-}++--isInstanceOf :: Object -> JSVal -> GHCJSPure Bool+--isInstanceOf o s = js_isInstanceOf o s+--{-# INLINE isInstanceOf #-}

@@ -0,0 +1,19 @@+module JavaScript.TypedArray+    ( TypedArray(..)+    , Int8Array, Int16Array, Int32Array+    , Uint8Array, Uint16Array, Uint32Array+    , Uint8ClampedArray, Float32Array, Float64Array+    , length+    , byteLength+    , byteOffset+    , buffer+    , subarray+    , set+    , unsafeSet+    ) where++import Prelude ()++import JavaScript.TypedArray.Internal+import JavaScript.TypedArray.Internal.Types+

@@ -0,0 +1,51 @@+module JavaScript.TypedArray.ArrayBuffer+    ( ArrayBuffer+    , MutableArrayBuffer+    , freeze, unsafeFreeze+    , thaw, unsafeThaw+    , byteLengthIO+    ) where++import Control.Lens.Operators ((^.))++import GHCJS.Marshal (fromJSValUnchecked)++import Language.Javascript.JSaddle.Types (JSM)+import Language.Javascript.JSaddle.Object (jsg, new, js, js1, js2)+import JavaScript.TypedArray.ArrayBuffer.Internal++create :: Int -> JSM MutableArrayBuffer+create n = SomeArrayBuffer <$> new (jsg "ArrayBuffer") [n]+{-# INLINE create #-}++{- | Create an immutable 'ArrayBuffer' by copying a 'MutableArrayBuffer' -}+freeze :: MutableArrayBuffer -> JSM ArrayBuffer+freeze (SomeArrayBuffer b) = SomeArrayBuffer <$> b ^. js1 "slice" (0 :: Int)+{-# INLINE freeze #-}++{- | Create an immutable 'ArrayBuffer' from a 'MutableArrayBuffer' without+     copying. The result shares the buffer with the argument,  not modify+     the data in the 'MutableArrayBuffer' after freezing+ -}+unsafeFreeze :: MutableArrayBuffer -> JSM ArrayBuffer+unsafeFreeze (SomeArrayBuffer b) = pure (SomeArrayBuffer b)+{-# INLINE unsafeFreeze #-}++{- | Create a 'MutableArrayBuffer' by copying an immutable 'ArrayBuffer' -}+thaw :: ArrayBuffer -> JSM MutableArrayBuffer+thaw (SomeArrayBuffer b) = SomeArrayBuffer <$> b ^. js1 "slice" (0 :: Int)+{-# INLINE thaw #-}++unsafeThaw :: ArrayBuffer -> JSM MutableArrayBuffer+unsafeThaw (SomeArrayBuffer b) = pure (SomeArrayBuffer b)+{-# INLINE unsafeThaw #-}++sliceIO :: Int -> Maybe Int -> SomeArrayBuffer any -> JSM (SomeArrayBuffer any)+sliceIO begin (Just end) (SomeArrayBuffer b) = SomeArrayBuffer <$> b ^. js2 "slice" begin end+sliceIO begin _          (SomeArrayBuffer b) = SomeArrayBuffer <$> b ^. js1 "slice" begin+{-# INLINE sliceIO #-}++byteLengthIO :: SomeArrayBuffer any -> JSM Int+byteLengthIO (SomeArrayBuffer b) = b ^. js "byteLength" >>= fromJSValUnchecked+{-# INLINE byteLengthIO #-}+

@@ -0,0 +1,33 @@+{-# LANGUAGE GHCForeignImportPrim #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}++module JavaScript.TypedArray.ArrayBuffer.Internal where++import GHCJS.Types++import GHCJS.Internal.Types+import GHCJS.Marshal.Pure++import GHC.Exts (State#)++import Data.Typeable++newtype SomeArrayBuffer (a :: MutabilityType s) =+  SomeArrayBuffer JSVal deriving Typeable+instance IsJSVal (SomeArrayBuffer m)++type ArrayBuffer           = SomeArrayBuffer Immutable+type MutableArrayBuffer    = SomeArrayBuffer Mutable+type STArrayBuffer s       = SomeArrayBuffer (STMutable s)++instance PToJSVal MutableArrayBuffer where+  pToJSVal (SomeArrayBuffer b) = b+instance PFromJSVal MutableArrayBuffer where+  pFromJSVal = SomeArrayBuffer

@@ -0,0 +1,6 @@+module JavaScript.TypedArray.ArrayBuffer.Type where++import GHCJS.Prim+++

@@ -0,0 +1,147 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE JavaScriptFFI #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE UnliftedFFITypes #-}+{-# LANGUAGE GHCForeignImportPrim #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}++module JavaScript.TypedArray.DataView.Internal where++import Data.Int+import Data.Typeable+import Data.Word++import GHC.Exts ( State# )++import GHCJS.Prim+import GHCJS.Internal.Types++import JavaScript.TypedArray.ArrayBuffer.Internal++newtype SomeDataView (a :: MutabilityType s) = SomeDataView JSVal+  deriving Typeable++type DataView        = SomeDataView Immutable+type MutableDataView = SomeDataView Mutable+type STDataView s    = SomeDataView (STMutable s)++-- #define JSU foreign import javascript unsafe+-- #define JSS foreign import javascript safe+--+--JSU "new DataView($1)"+--    js_dataView1 :: JSVal -> JSVal+--JSS "new DataView($2,$1)"+--    js_dataView2 :: Int -> JSVal -> SomeDataView m+--JSU "new DataView($2,$1)"+--    js_unsafeDataView2 :: Int -> JSVal-> SomeDataView m+--JSS "new DataView($3,$1,$2)"+--    js_dataView :: Int -> Int -> JSVal -> SomeDataView m+--JSU "new DataView($3,$1,$2)"+--    js_unsafeDataView :: Int -> Int -> JSVal -> JSVal+--JSU "new DataView($1.buffer.slice($1.byteOffset, $1.byteLength))"+--    js_cloneDataView :: SomeDataView m -> IO (SomeDataView m1)+--+---- ----------------------------------------------------------------------------+---- immutable getters+--+--JSU "$2.getInt8($1)"          js_i_unsafeGetInt8       :: Int -> DataView -> Int8+--JSU "$2.getUint8($1)"         js_i_unsafeGetUint8      :: Int -> DataView -> Word8+--JSU "$2.getInt16($1)"         js_i_unsafeGetInt16BE    :: Int -> DataView -> Int16+--JSU "$2.getInt32($1)"         js_i_unsafeGetInt32BE    :: Int -> DataView -> Int+--JSU "$2.getUint16($1)"        js_i_unsafeGetUint16BE   :: Int -> DataView -> Word16+--JSU "$2.getUint32($1)|0"      js_i_unsafeGetUint32BE   :: Int -> DataView -> Word+--JSU "$2.getFloat32($1)"       js_i_unsafeGetFloat32BE  :: Int -> DataView -> Double+--JSU "$2.getFloat64($1)"       js_i_unsafeGetFloat64BE  :: Int -> DataView -> Double+--JSU "$2.getInt16($1,true)"    js_i_unsafeGetInt16LE    :: Int -> DataView -> Int16+--JSU "$2.getInt32($1,true)"    js_i_unsafeGetInt32LE    :: Int -> DataView -> Int+--JSU "$2.getUint16($1,true)"   js_i_unsafeGetUint16LE   :: Int -> DataView -> Word16+--JSU "$2.getUint32($1,true)|0" js_i_unsafeGetUint32LE   :: Int -> DataView -> Word+--JSU "$2.getFloat32($1,true)"  js_i_unsafeGetFloat32LE  :: Int -> DataView -> Double+--JSU "$2.getFloat64($1,true)"  js_i_unsafeGetFloat64LE  :: Int -> DataView -> Double+--+--JSS "$2.getInt8($1)"          js_i_getInt8       :: Int -> DataView -> Int8+--JSS "$2.getUint8($1)"         js_i_getUint8      :: Int -> DataView -> Word8+--JSS "$2.getInt16($1)"         js_i_getInt16BE    :: Int -> DataView -> Int16+--JSS "$2.getInt32($1)"         js_i_getInt32BE    :: Int -> DataView -> Int+--JSS "$2.getUint16($1)"        js_i_getUint16BE   :: Int -> DataView -> Word16+--JSS "$2.getUint32($1)|0"      js_i_getUint32BE   :: Int -> DataView -> Word+--JSS "$2.getFloat32($1)"       js_i_getFloat32BE  :: Int -> DataView -> Double+--JSS "$2.getFloat64($1)"       js_i_getFloat64BE  :: Int -> DataView -> Double+--JSS "$2.getInt16($1,true)"    js_i_getInt16LE    :: Int -> DataView -> Int16+--JSS "$2.getInt32($1,true)"    js_i_getInt32LE    :: Int -> DataView -> Int+--JSS "$2.getUint16($1,true)"   js_i_getUint16LE   :: Int -> DataView -> Word16+--JSS "$2.getUint32($1,true)|0" js_i_getUint32LE   :: Int -> DataView -> Word+--JSS "$2.getFloat32($1,true)"  js_i_getFloat32LE  :: Int -> DataView -> Double+--JSS "$2.getFloat64($1,true)"  js_i_getFloat64LE  :: Int -> DataView -> Double+--+---- ----------------------------------------------------------------------------+---- mutable getters+--+--JSU "$2.getInt8($1)"          js_m_unsafeGetInt8      :: Int -> SomeDataView m -> State# s -> (# State# s, Int8   #)+--JSU "$2.getUint8($1)"         js_m_unsafeGetUint8     :: Int -> SomeDataView m -> State# s -> (# State# s, Word8  #)+--JSU "$2.getInt16($1)"         js_m_unsafeGetInt16BE   :: Int -> SomeDataView m -> State# s -> (# State# s, Int16  #)+--JSU "$2.getInt32($1)"         js_m_unsafeGetInt32BE   :: Int -> SomeDataView m -> State# s -> (# State# s, Int    #)+--JSU "$2.getUint16($1)"        js_m_unsafeGetUint16BE  :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #)+--JSU "$2.getUint32($1)|0"      js_m_unsafeGetUint32BE  :: Int -> SomeDataView m -> State# s -> (# State# s, Word   #)+--JSU "$2.getFloat32($1)"       js_m_unsafeGetFloat32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #)+--JSU "$2.getFloat64($1)"       js_m_unsafeGetFloat64BE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #)+--JSU "$2.getInt16($1,true)"    js_m_unsafeGetInt16LE   :: Int -> SomeDataView m -> State# s -> (# State# s, Int16  #)+--JSU "$2.getInt32($1,true)"    js_m_unsafeGetInt32LE   :: Int -> SomeDataView m -> State# s -> (# State# s, Int    #)+--JSU "$2.getUint16($1,true)"   js_m_unsafeGetUint16LE  :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #)+--JSU "$2.getUint32($1,true)|0" js_m_unsafeGetUint32LE  :: Int -> SomeDataView m -> State# s -> (# State# s, Word   #)+--JSU "$2.getFloat32($1,true)"  js_m_unsafeGetFloat32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #)+--JSU "$2.getFloat64($1,true)"  js_m_unsafeGetFloat64LE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #)+--+--JSS "$2.getInt8($1)"          js_m_getInt8            :: Int -> SomeDataView m -> State# s -> (# State# s, Int8   #)+--JSS "$2.getUint8($1)"         js_m_getUint8           :: Int -> SomeDataView m -> State# s -> (# State# s, Word8  #)+--JSS "$2.getInt16($1)"         js_m_getInt16BE         :: Int -> SomeDataView m -> State# s -> (# State# s, Int16  #)+--JSS "$2.getInt32($1)"         js_m_getInt32BE         :: Int -> SomeDataView m -> State# s -> (# State# s, Int    #)+--JSS "$2.getUint16($1)"        js_m_getUint16BE        :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #)+--JSS "$2.getUint32($1)|0"      js_m_getUint32BE        :: Int -> SomeDataView m -> State# s -> (# State# s, Word   #)+--JSS "$2.getFloat32($1)"       js_m_getFloat32BE       :: Int -> SomeDataView m -> State# s -> (# State# s, Double #)+--JSS "$2.getFloat64($1)"       js_m_getFloat64BE       :: Int -> SomeDataView m -> State# s -> (# State# s, Double #)+--JSS "$2.getInt16($1,true)"    js_m_getInt16LE         :: Int -> SomeDataView m -> State# s -> (# State# s, Int16  #)+--JSS "$2.getInt32($1,true)"    js_m_getInt32LE         :: Int -> SomeDataView m -> State# s -> (# State# s, Int    #)+--JSS "$2.getUint16($1,true)"   js_m_getUint16LE        :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #)+--JSS "$2.getUint32($1,true)|0" js_m_getUint32LE        :: Int -> SomeDataView m -> State# s -> (# State# s, Word   #)+--JSS "$2.getFloat32($1,true)"  js_m_getFloat32LE       :: Int -> SomeDataView m -> State# s -> (# State# s, Double #)+--JSS "$2.getFloat64($1,true)"  js_m_getFloat64LE       :: Int -> SomeDataView m -> State# s -> (# State# s, Double #)+--+---- ----------------------------------------------------------------------------+---- mutable setters+--+--JSU "$3.setInt8($1,$2)"         js_unsafeSetInt8      :: Int -> Int8   -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setUint8($1,$2)"        js_unsafeSetUint8     :: Int -> Word8  -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setInt16($1,$2)"        js_unsafeSetInt16BE   :: Int -> Int16  -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setInt32($1,$2)"        js_unsafeSetInt32BE   :: Int -> Int    -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setUint16($1,$2)"       js_unsafeSetUint16BE  :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setUint32($1,$2)"       js_unsafeSetUint32BE  :: Int -> Word   -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setFloat32($1,$2)"      js_unsafeSetFloat32BE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setFloat64($1,$2)"      js_unsafeSetFloat64BE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setInt16($1,$2,true)"   js_unsafeSetInt16LE   :: Int -> Int16  -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setInt32($1,$2,true)"   js_unsafeSetInt32LE   :: Int -> Int    -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setUint16($1,$2,true)"  js_unsafeSetUint16LE  :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setUint32($1,$2,true)"  js_unsafeSetUint32LE  :: Int -> Word   -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setFloat32($1,$2,true)" js_unsafeSetFloat32LE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #)+--JSU "$3.setFloat64($1,$2,true)" js_unsafeSetFloat64LE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #)+--+--JSS "$3.setInt8($1,$2)"         js_setInt8            :: Int -> Int8   -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setUint8($1,$2)"        js_setUint8           :: Int -> Word8  -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setInt16($1,$2)"        js_setInt16BE         :: Int -> Int16  -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setInt32($1,$2)"        js_setInt32BE         :: Int -> Int    -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setUint16($1,$2)"       js_setUint16BE        :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setUint32($1,$2)"       js_setUint32BE        :: Int -> Word   -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setFloat32($1,$2)"      js_setFloat32BE       :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setFloat64($1,$2)"      js_setFloat64BE       :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setInt16($1,$2,true)"   js_setInt16LE         :: Int -> Int16  -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setInt32($1,$2,true)"   js_setInt32LE         :: Int -> Int    -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setUint16($1,$2,true)"  js_setUint16LE        :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setUint32($1,$2,true)"  js_setUint32LE        :: Int -> Word   -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setFloat32($1,$2,true)" js_setFloat32LE       :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #)+--JSS "$3.setFloat64($1,$2,true)" js_setFloat64LE       :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #)+

@@ -0,0 +1,1 @@+module JavaScript.TypedArray.Immutable where

@@ -0,0 +1,344 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}++module JavaScript.TypedArray.Internal where++import Prelude hiding ((!!))++import GHC.Int+import GHC.Word++import GHCJS.Internal.Types++import Control.Monad (void)+import Control.Lens.Operators ((^.))++import GHCJS.Marshal (fromJSValUnchecked)++import JavaScript.Array.Internal (SomeJSArray(..))+import JavaScript.TypedArray.ArrayBuffer+import JavaScript.TypedArray.ArrayBuffer.Internal (SomeArrayBuffer(..))+import JavaScript.TypedArray.Internal.Types++import Language.Javascript.JSaddle.Types (JSM, GHCJSPure(..))+import Language.Javascript.JSaddle.Object (js, jsg, js1, js2, new, (!!), (<##))++elemSize :: SomeTypedArray e m -> GHCJSPure Int+elemSize (SomeTypedArray a) = GHCJSPure $ a ^. js "BYTES_PER_ELEMENT" >>= fromJSValUnchecked+{-# INLINE [1] elemSize #-}+{-# RULES "elemSizeUint8Clamped" forall (x :: SomeUint8ClampedArray m). elemSize x = GHCJSPure $ return 1 #-}+{-# RULES "elemSizeUint8"        forall (x :: SomeUint8Array m).        elemSize x = GHCJSPure $ return 1 #-}+{-# RULES "elemSizeUint16"       forall (x :: SomeUint16Array m).       elemSize x = GHCJSPure $ return 2 #-}+{-# RULES "elemSizeUint32"       forall (x :: SomeUint32Array m).       elemSize x = GHCJSPure $ return 4 #-}+{-# RULES "elemSizeInt8"         forall (x :: SomeInt8Array m).         elemSize x = GHCJSPure $ return 1 #-}+{-# RULES "elemSizeInt16"        forall (x :: SomeInt16Array m).        elemSize x = GHCJSPure $ return 2 #-}+{-# RULES "elemSizeInt32"        forall (x :: SomeInt32Array m).        elemSize x = GHCJSPure $ return 4 #-}+{-# RULES "elemSizeFloat32"      forall (x :: SomeFloat32Array m).      elemSize x = GHCJSPure $ return 4 #-}+{-# RULES "elemSizeFloat64"      forall (x :: SomeFloat64Array m).      elemSize x = GHCJSPure $ return 8 #-}++instance TypedArray IOInt8Array where+  index              = indexI8+  unsafeIndex        = unsafeIndexI8+  setIndex i x       = setIndexI i (fromIntegral x)+  unsafeSetIndex i x = unsafeSetIndexI i (fromIntegral x)+  indexOf s x        = indexOfI s (fromIntegral x)+  lastIndexOf s x    = lastIndexOfI s (fromIntegral x)+  create l           = SomeTypedArray <$> new (jsg "Int8Array") [l]+  fromArray          = int8ArrayFrom+  fromArrayBuffer    = undefined++instance TypedArray IOInt16Array where+  index              = indexI16+  unsafeIndex        = unsafeIndexI16+  setIndex i x       = setIndexI i (fromIntegral x)+  unsafeSetIndex i x = unsafeSetIndexI i (fromIntegral x)+  indexOf s x        = indexOfI s (fromIntegral x)+  lastIndexOf s x    = lastIndexOfI s (fromIntegral x)+  create l           = SomeTypedArray <$> new (jsg "Int16Array") [l]+  fromArray          = int16ArrayFrom+  fromArrayBuffer    = undefined++instance TypedArray IOInt32Array where+  index           = indexI+  unsafeIndex     = unsafeIndexI+  setIndex        = setIndexI+  unsafeSetIndex  = unsafeSetIndexI+  indexOf         = indexOfI+  lastIndexOf     = lastIndexOfI+  create l        = SomeTypedArray <$> new (jsg "Int32Array") [l]+  fromArray       = int32ArrayFrom+  fromArrayBuffer = undefined++instance TypedArray IOUint8ClampedArray where+  index              = indexW8+  unsafeIndex        = unsafeIndexW8+  setIndex i x       = setIndexW i (fromIntegral x)+  unsafeSetIndex i x = unsafeSetIndexW i (fromIntegral x)+  indexOf s x        = indexOfW s (fromIntegral x)+  lastIndexOf s x    = lastIndexOfW s (fromIntegral x)+  create l           = SomeTypedArray <$> new (jsg "Uint8ClampedArray") [l]+  fromArray          = uint8ClampedArrayFrom+  fromArrayBuffer    = undefined++instance TypedArray IOUint8Array where+  index              = indexW8+  unsafeIndex        = unsafeIndexW8+  setIndex i x       = setIndexW i (fromIntegral x)+  unsafeSetIndex i x = unsafeSetIndexW i (fromIntegral x)+  indexOf s x        = indexOfW s (fromIntegral x)+  lastIndexOf s x    = lastIndexOfW s (fromIntegral x)+  create l           = SomeTypedArray <$> new (jsg "Uint8Array") [l]+  fromArray          = uint8ArrayFrom+  fromArrayBuffer    = undefined++instance TypedArray IOUint16Array where+  index              = indexW16+  unsafeIndex        = unsafeIndexW16+  setIndex i x       = setIndexW i (fromIntegral x)+  unsafeSetIndex i x = unsafeSetIndexW i (fromIntegral x)+  indexOf s x        = indexOfW s (fromIntegral x)+  lastIndexOf s x    = lastIndexOfW s (fromIntegral x)+  create l           = SomeTypedArray <$> new (jsg "Uint16Array") [l]+  fromArray          = uint16ArrayFrom+  fromArrayBuffer    = undefined++instance TypedArray IOUint32Array where+  index           = indexW+  unsafeIndex     = unsafeIndexW+  setIndex        = setIndexW+  unsafeSetIndex  = unsafeSetIndexW+  indexOf         = indexOfW+  lastIndexOf     = lastIndexOfW+  create l        = SomeTypedArray <$> new (jsg "Uint32Array") [l]+  fromArray       = uint32ArrayFrom+  fromArrayBuffer = undefined++instance TypedArray IOFloat32Array where+  index           = indexD+  unsafeIndex     = unsafeIndexD+  setIndex        = setIndexD+  unsafeSetIndex  = unsafeSetIndexD+  indexOf         = indexOfD+  lastIndexOf     = lastIndexOfD+  create l        = SomeTypedArray <$> new (jsg "Float32Array") [l]+  fromArray       = float32ArrayFrom+  fromArrayBuffer = undefined++instance TypedArray IOFloat64Array where+  index           = indexD+  unsafeIndex     = unsafeIndexD+  setIndex        = setIndexD+  unsafeSetIndex  = unsafeSetIndexD+  indexOf         = indexOfD+  lastIndexOf     = lastIndexOfD+  create l        = SomeTypedArray <$> new (jsg "Float64Array") [l]+  fromArray       = float64ArrayFrom+  fromArrayBuffer = undefined+++class TypedArray a where+  unsafeIndex     :: Int           -> a -> JSM (Elem a)+  index           :: Int           -> a -> JSM (Elem a)+  unsafeSetIndex  :: Int -> Elem a -> a -> JSM ()+  setIndex        :: Int -> Elem a -> a -> JSM ()+  create          :: Int                -> JSM a+  fromArray       :: SomeJSArray m      -> JSM a+  fromArrayBuffer :: MutableArrayBuffer -> Int    -> Maybe Int -> JSM a+  indexOf         :: Int                -> Elem a -> a -> JSM Int+  lastIndexOf     :: Int                -> Elem a -> a -> JSM Int++-- -----------------------------------------------------------------------------++indexI :: Int -> SomeTypedArray e m -> JSM Int+indexI i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE indexI #-}++indexI16 :: Int -> SomeTypedArray e m -> JSM Int16+indexI16 i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE indexI16 #-}++indexI8 :: Int -> SomeTypedArray e m -> JSM Int8+indexI8 i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE indexI8 #-}++indexW :: Int -> SomeTypedArray e m -> JSM Word+indexW i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE indexW #-}++indexW16 :: Int -> SomeTypedArray e m -> JSM Word16+indexW16 i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE indexW16 #-}++indexW8 :: Int -> SomeTypedArray e m -> JSM Word8+indexW8 i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE indexW8 #-}++indexD :: Int -> SomeTypedArray e m -> JSM Double+indexD i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE indexD #-}++-- -----------------------------------------------------------------------------++unsafeIndexI :: Int -> SomeTypedArray e m -> JSM Int+unsafeIndexI i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE unsafeIndexI #-}++unsafeIndexI16 :: Int -> SomeTypedArray e m -> JSM Int16+unsafeIndexI16 i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE unsafeIndexI16 #-}++unsafeIndexI8 :: Int -> SomeTypedArray e m -> JSM Int8+unsafeIndexI8 i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE unsafeIndexI8 #-}++unsafeIndexW :: Int -> SomeTypedArray e m -> JSM  Word+unsafeIndexW i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE unsafeIndexW #-}++unsafeIndexW16 :: Int -> SomeTypedArray e m -> JSM Word16+unsafeIndexW16 i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE unsafeIndexW16 #-}++unsafeIndexW8 :: Int -> SomeTypedArray e m -> JSM Word8+unsafeIndexW8 i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE unsafeIndexW8 #-}++unsafeIndexD :: Int -> SomeTypedArray e m -> JSM Double+unsafeIndexD i (SomeTypedArray a) = a !! i >>= fromJSValUnchecked+{-# INLINE unsafeIndexD #-}++-- -----------------------------------------------------------------------------++int8ArrayFrom :: SomeJSArray m0 -> JSM (SomeInt8Array m1)+int8ArrayFrom (SomeJSArray a) = SomeTypedArray <$> jsg "Int8Array" ^. js1 "from" a+{-# INLINE int8ArrayFrom #-}++int16ArrayFrom :: SomeJSArray m0 -> JSM (SomeInt16Array m1)+int16ArrayFrom (SomeJSArray a) = SomeTypedArray <$> jsg "Int16Array" ^. js1 "from" a+{-# INLINE int16ArrayFrom #-}++int32ArrayFrom :: SomeJSArray m0 -> JSM (SomeInt32Array m1)+int32ArrayFrom (SomeJSArray a) = SomeTypedArray <$> jsg "Int32Array" ^. js1 "from" a+{-# INLINE int32ArrayFrom #-}++uint8ArrayFrom :: SomeJSArray m0 -> JSM (SomeUint8Array m1)+uint8ArrayFrom (SomeJSArray a) = SomeTypedArray <$> jsg "Uint8Array" ^. js1 "from" a+{-# INLINE uint8ArrayFrom #-}++uint8ClampedArrayFrom :: SomeJSArray m0 -> JSM (SomeUint8ClampedArray m1)+uint8ClampedArrayFrom (SomeJSArray a) = SomeTypedArray <$> jsg "Uint8ClampedArray" ^. js1 "from" a+{-# INLINE uint8ClampedArrayFrom #-}++uint16ArrayFrom :: SomeJSArray m0 -> JSM (SomeUint16Array m1)+uint16ArrayFrom (SomeJSArray a) = SomeTypedArray <$> jsg "Uint16Array" ^. js1 "from" a+{-# INLINE uint16ArrayFrom #-}++uint32ArrayFrom :: SomeJSArray m0 -> JSM (SomeUint32Array m1)+uint32ArrayFrom (SomeJSArray a) = SomeTypedArray <$> jsg "Uint32Array" ^. js1 "from" a+{-# INLINE uint32ArrayFrom #-}++float32ArrayFrom :: SomeJSArray m0 -> JSM (SomeFloat32Array m1)+float32ArrayFrom (SomeJSArray a) = SomeTypedArray <$> jsg "Float32Array" ^. js1 "from" a+{-# INLINE float32ArrayFrom #-}++float64ArrayFrom :: SomeJSArray m0 -> JSM (SomeFloat64Array m1)+float64ArrayFrom (SomeJSArray a) = SomeTypedArray <$> jsg "Float64Array" ^. js1 "from" a+{-# INLINE float64ArrayFrom #-}++-- -----------------------------------------------------------------------------++setIndexI :: Mutability m ~ IsMutable+          => Int -> Int -> SomeTypedArray e m -> JSM ()+setIndexI i x (SomeTypedArray a) = (a <## i) x+{-# INLINE setIndexI #-}++unsafeSetIndexI :: Mutability m ~ IsMutable+                => Int -> Int -> SomeTypedArray e m -> JSM ()+unsafeSetIndexI i x (SomeTypedArray a) = (a <## i) x+{-# INLINE unsafeSetIndexI #-}++setIndexW :: Mutability m ~ IsMutable+           => Int -> Word -> SomeTypedArray e m -> JSM ()+setIndexW i x (SomeTypedArray a) = (a <## i) x+{-# INLINE setIndexW #-}++unsafeSetIndexW :: Mutability m ~ IsMutable+                => Int -> Word -> SomeTypedArray e m -> JSM ()+unsafeSetIndexW i x (SomeTypedArray a) = (a <## i) x+{-# INLINE unsafeSetIndexW #-}++setIndexD :: Mutability m ~ IsMutable+          => Int -> Double -> SomeTypedArray e m -> JSM ()+setIndexD i x (SomeTypedArray a) = (a <## i) x+{-# INLINE setIndexD #-}++unsafeSetIndexD :: Mutability m ~ IsMutable+                => Int -> Double -> SomeTypedArray e m -> JSM ()+unsafeSetIndexD i x (SomeTypedArray a) = (a <## i) x+{-# INLINE unsafeSetIndexD #-}++indexOfI :: Mutability m ~ IsMutable+         => Int -> Int -> SomeTypedArray e m -> JSM Int+indexOfI s x (SomeTypedArray a) = a ^. js2 "indexOf" x s >>= fromJSValUnchecked+{-# INLINE indexOfI #-}++indexOfW :: Int -> Word -> SomeTypedArray e m -> JSM Int+indexOfW s x (SomeTypedArray a) = a ^. js2 "indexOf" x s >>= fromJSValUnchecked+{-# INLINE indexOfW #-}++indexOfD :: Int -> Double -> SomeTypedArray e m -> JSM Int+indexOfD s x (SomeTypedArray a) = a ^. js2 "indexOf" x s >>= fromJSValUnchecked+{-# INLINE indexOfD #-}++lastIndexOfI :: Int -> Int -> SomeTypedArray e m -> JSM Int+lastIndexOfI s x (SomeTypedArray a) = a ^. js2 "lastIndexOf" x s >>= fromJSValUnchecked+{-# INLINE lastIndexOfI #-}++lastIndexOfW :: Int -> Word -> SomeTypedArray e m -> JSM Int+lastIndexOfW s x (SomeTypedArray a) = a ^. js2 "lastIndexOf" x s >>= fromJSValUnchecked+{-# INLINE lastIndexOfW #-}++lastIndexOfD :: Int -> Double -> SomeTypedArray e m -> JSM Int+lastIndexOfD s x (SomeTypedArray a) = a ^. js2 "lastIndexOf" x s >>= fromJSValUnchecked+{-# INLINE lastIndexOfD #-}++-- -----------------------------------------------------------------------------+-- non-class operations usable for all typed array+{-| length of the typed array in elements -}+length :: SomeTypedArray e m -> GHCJSPure Int+length (SomeTypedArray a) = GHCJSPure $ a ^. js "length" >>= fromJSValUnchecked+{-# INLINE length #-}++{-| length of the array in bytes -}+byteLength :: SomeTypedArray e m -> GHCJSPure Int+byteLength (SomeTypedArray a) = GHCJSPure $ a ^. js "byteLength" >>= fromJSValUnchecked+{-# INLINE byteLength #-}++{-| offset of the array in the buffer -}+byteOffset :: SomeTypedArray e m -> GHCJSPure Int+byteOffset (SomeTypedArray a) = GHCJSPure $ a ^. js "byteOffset" >>= fromJSValUnchecked+{-# INLINE byteOffset #-}++{-| the underlying buffer of the array -}+buffer :: SomeTypedArray e m -> GHCJSPure (SomeArrayBuffer m)+buffer (SomeTypedArray a) = GHCJSPure $ SomeArrayBuffer <$> a ^. js "buffer"+{-# INLINE buffer #-}++{-| create a view of the existing array -}+subarray :: Int -> Int -> SomeTypedArray e m -> GHCJSPure (SomeTypedArray e m)+subarray begin end (SomeTypedArray a) = GHCJSPure$ SomeTypedArray <$> a ^. js2 "subarray" begin end+{-# INLINE subarray #-}++-- fixme convert JSException to Haskell exception+{-| copy the elements of one typed array to another -}+set :: Int -> SomeTypedArray e m -> SomeTypedArray e1 Mutable -> GHCJSPure ()+set offset (SomeTypedArray src) (SomeTypedArray dest) = GHCJSPure $ void $ dest ^. js2 "set" offset src+{-# INLINE set #-}++unsafeSet :: Int -> SomeTypedArray e m -> SomeTypedArray e1 Mutable -> GHCJSPure ()+unsafeSet offset (SomeTypedArray src) (SomeTypedArray dest) = GHCJSPure $ void $ dest ^. js2 "set" offset src+{-# INLINE unsafeSet #-}+

@@ -0,0 +1,121 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}++module JavaScript.TypedArray.Internal.Types where++import GHCJS.Types+import GHCJS.Internal.Types+import Language.Javascript.JSaddle (IsJSVal)++import Data.Int+import Data.Typeable+import Data.Word++newtype SomeTypedArray (e :: TypedArrayElem) (m :: MutabilityType s) =+  SomeTypedArray JSVal deriving Typeable+instance IsJSVal (SomeTypedArray e m)++{-+newtype SomeSTTypedArray s e = SomeSTTypedArray JSVal+  deriving (Typeable)+-}++type SomeSTTypedArray s (e :: TypedArrayElem) = SomeTypedArray e (STMutable s)++-- -----------------------------------------------------------------------------++data TypedArrayElem = Int8Elem+                    | Int16Elem+                    | Int32Elem+                    | Uint8Elem+                    | Uint16Elem+                    | Uint32Elem+                    | Uint8ClampedElem+                    | Float32Elem+                    | Float64Elem++-- -----------------------------------------------------------------------------++type SomeInt8Array         = SomeTypedArray        Int8Elem+type SomeInt16Array        = SomeTypedArray        Int16Elem+type SomeInt32Array        = SomeTypedArray        Int32Elem++type SomeUint8Array        = SomeTypedArray        Uint8Elem+type SomeUint16Array       = SomeTypedArray        Uint16Elem+type SomeUint32Array       = SomeTypedArray        Uint32Elem++type SomeFloat32Array      = SomeTypedArray        Float32Elem+type SomeFloat64Array      = SomeTypedArray        Float64Elem++type SomeUint8ClampedArray = SomeTypedArray        Uint8ClampedElem++-- -----------------------------------------------------------------------------++type Int8Array             = SomeInt8Array         Immutable+type Int16Array            = SomeInt16Array        Immutable+type Int32Array            = SomeInt32Array        Immutable++type Uint8Array            = SomeUint8Array        Immutable+type Uint16Array           = SomeUint16Array       Immutable+type Uint32Array           = SomeUint32Array       Immutable++type Uint8ClampedArray     = SomeUint8ClampedArray Immutable++type Float32Array          = SomeFloat32Array      Immutable+type Float64Array          = SomeFloat64Array      Immutable++-- -----------------------------------------------------------------------------++type IOInt8Array           = SomeInt8Array         Mutable+type IOInt16Array          = SomeInt16Array        Mutable+type IOInt32Array          = SomeInt32Array        Mutable++type IOUint8Array          = SomeUint8Array        Mutable+type IOUint16Array         = SomeUint16Array       Mutable+type IOUint32Array         = SomeUint32Array       Mutable++type IOUint8ClampedArray   = SomeUint8ClampedArray Mutable++type IOFloat32Array        = SomeFloat32Array      Mutable+type IOFloat64Array        = SomeFloat64Array      Mutable++-- -----------------------------------------------------------------------------++type STInt8Array s         = SomeSTTypedArray s Int8Elem+type STInt16Array s        = SomeSTTypedArray s Int16Elem+type STInt32Array s        = SomeSTTypedArray s Int32Elem++type STUint8Array s        = SomeSTTypedArray s Uint8Elem+type STUint16Array s       = SomeSTTypedArray s Uint16Elem+type STUint32Array s       = SomeSTTypedArray s Uint32Elem++type STFloat32Array s      = SomeSTTypedArray s Float32Elem+type STFloat64Array s      = SomeSTTypedArray s Float64Elem++type STUint8ClampedArray s = SomeSTTypedArray s Uint8ClampedElem++-- -----------------------------------------------------------------------------++type family Elem x where+    Elem (SomeUint8Array m)        = Word8+    Elem (SomeUint8ClampedArray m) = Word8+    Elem (SomeUint16Array m)       = Word16+    Elem (SomeUint32Array m)       = Word+    Elem (SomeInt8Array m)         = Int8+    Elem (SomeInt16Array m)        = Int16+    Elem (SomeInt32Array m)        = Int+    Elem (SomeFloat32Array m)      = Double+    Elem (SomeFloat64Array m)      = Double++    Elem (STUint8Array s)          = Word8+    Elem (STUint8ClampedArray s)   = Word8+    Elem (STUint16Array s)         = Word16+    Elem (STUint32Array s)         = Word+    Elem (STInt8Array s)           = Int8+    Elem (STInt16Array s)          = Int16+    Elem (STInt32Array s)          = Int+    Elem (STFloat32Array s)        = Double+    Elem (STFloat64Array s)        = Double+

@@ -1,121 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE Rank2Types #-}-#ifdef ghcjs_HOST_OS-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE JavaScriptFFI #-}-{-# OPTIONS_GHC -Wno-dodgy-exports -Wno-dodgy-imports #-}-#endif-{-# OPTIONS_GHC -fno-warn-orphans #-}------------------------------------------------------------------------------------ Module      :  Language.Javascript.JSaddle.Object--- Copyright   :  (c) Hamish Mackenzie--- License     :  MIT------ Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>------ | Interface to JavaScript array-----------------------------------------------------------------------------------module Language.Javascript.JSaddle.Array-    ( SomeJSArray(..)-    , JSArray-    , MutableJSArray-    , create-    , length-    , lengthIO-    , nullIO-    , fromListIO-    , toListIO-    , read-    , write-    , append-    , push-    , pop-    , unshift-    , shift-    , reverse-    , takeIO-    , dropIO-    , sliceIO-    , freeze-    , unsafeFreeze-    , thaw-    , unsafeThaw-    ) where--import Prelude hiding (read, reverse, null)-import Control.Monad (void)-import Language.Javascript.JSaddle.Types-       (JSM, JSVal, SomeJSArray(..), JSArray,-        MutableJSArray)-import Control.Lens.Operators ((^.))-import Language.Javascript.JSaddle.Object (js2, js0, (##), js1, js)-import Language.Javascript.JSaddle.Value (valToNumber)-import JavaScript.Array.Internal (create, fromListIO, toListIO, read, push)--lengthIO :: SomeJSArray m -> JSM Int-lengthIO (SomeJSArray x) = round <$> (x ^. js "length" >>= valToNumber)-{-# INLINE lengthIO #-}--nullIO :: SomeJSArray m -> JSM Bool-nullIO = fmap (== 0) . lengthIO-{-# INLINE nullIO #-}--append :: SomeJSArray m -> SomeJSArray m -> JSM (SomeJSArray m1)-append (SomeJSArray x) (SomeJSArray y) = SomeJSArray <$> x ^. js1 "concat" y-{-# INLINE append #-}--write :: Int -> JSVal -> MutableJSArray -> JSM ()-write n e (SomeJSArray x) = void $ (x ## n) e-{-# INLINE write #-}--pop :: MutableJSArray -> JSM JSVal-pop (SomeJSArray x) = x ^. js0 "pop"-{-# INLINE pop #-}--unshift :: JSVal -> MutableJSArray -> JSM ()-unshift e (SomeJSArray x) = void $ x ^. js1 "unshift" e-{-# INLINE unshift #-}--shift :: MutableJSArray -> JSM JSVal-shift (SomeJSArray x) = x ^. js0 "shift"-{-# INLINE shift #-}--reverse :: MutableJSArray -> JSM ()-reverse (SomeJSArray x) = void $ x ^. js0 "reverse"-{-# INLINE reverse #-}--takeIO :: Int -> SomeJSArray m -> JSM (SomeJSArray m1)-takeIO n (SomeJSArray x) = SomeJSArray <$> x ^. js2 "slice" (0::Int) n-{-# INLINE takeIO #-}--dropIO :: Int -> SomeJSArray m -> JSM (SomeJSArray m1)-dropIO n (SomeJSArray x) = SomeJSArray <$> x ^. js1 "slice1" n-{-# INLINE dropIO #-}--sliceIO :: Int -> Int -> JSArray -> JSM (SomeJSArray m1)-sliceIO s n (SomeJSArray x) = SomeJSArray <$> x ^. js2 "slice" s n-{-# INLINE sliceIO #-}--freeze :: MutableJSArray -> JSM JSArray-freeze (SomeJSArray x) = SomeJSArray <$> x ^. js1 "slice" (0::Int)-{-# INLINE freeze #-}--unsafeFreeze :: MutableJSArray -> JSM JSArray-unsafeFreeze (SomeJSArray x) = pure (SomeJSArray x)-{-# INLINE unsafeFreeze #-}--thaw :: JSArray -> JSM MutableJSArray-thaw (SomeJSArray x) = SomeJSArray <$> x ^. js1 "slice" (0::Int)-{-# INLINE thaw #-}--unsafeThaw :: JSArray -> JSM MutableJSArray-unsafeThaw (SomeJSArray x) = pure (SomeJSArray x)-{-# INLINE unsafeThaw #-}--

@@ -27,9 +27,7 @@ import Language.Javascript.JSaddle.Types (JSString) #else import Language.Javascript.JSaddle.Native.Internal-       (withJSString)-import Language.Javascript.JSaddle.Run-       (AsyncCommand(..), sendLazyCommand)+       (evaluateScript) #endif import Language.Javascript.JSaddle.Marshal.String (ToJSString(..)) import Language.Javascript.JSaddle.Monad (JSM)@@ -55,7 +53,5 @@ foreign import javascript unsafe "$r = eval($1);"     js_eval :: JSString -> IO JSVal #else-eval script = do-    let rscript = toJSString script-    withJSString rscript $ sendLazyCommand . EvaluateScript+eval = evaluateScript . toJSString #endif

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- --@@ -17,7 +18,11 @@ ) where  import qualified Control.Exception as E (Exception)-import Language.Javascript.JSaddle.Types (JSVal)+#ifdef ghcjs_HOST_OS+import GHCJS.Prim (JSVal)+#else+import GHCJS.Prim.Internal (JSVal)+#endif import Data.Typeable (Typeable)  newtype JSException = JSException JSVal deriving (Typeable)

@@ -1,99 +0,0 @@-{-# LANGUAGE CPP #-}------------------------------------------------------------------------------------ Module      :  Language.Javascript.JSaddle.Value--- Copyright   :  (c) Hamish Mackenzie--- License     :  MIT------ Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>------ | This module is like `GHCJS.Foreign` but some functions are in----------------------------------------------------------------------------------module Language.Javascript.JSaddle.Foreign (-    jsTrue-  , jsFalse-  , jsNull-  , toJSBool---  , fromJSBoolIO-  , jsUndefined-  , isTruthyIO-  , isNullIO-  , isUndefinedIO---  , isObjectIO---  , isFunctionIO---  , isStringIO---  , isBooleanIO---  , isSymbolIO---  , isNumberIO-) where--#ifdef ghcjs_HOST_OS-import Language.Javascript.JSaddle.Types (JSM, JSVal)-import GHCJS.Foreign (toJSBool, isTruthy, jsNull, jsUndefined, jsTrue, jsFalse, isNull, isUndefined)-#else-import Language.Javascript.JSaddle.Types (JSM, JSVal(..))-import Language.Javascript.JSaddle.Native.Internal-       (withJSVal)-import Language.Javascript.JSaddle.Run-       (Command(..), Result(..), sendCommand)-#endif--#ifndef ghcjs_HOST_OS-jsTrue :: JSVal-jsTrue = JSVal 3-{-# INLINE jsTrue #-}--jsFalse :: JSVal-jsFalse = JSVal 2-{-# INLINE jsFalse #-}--jsNull :: JSVal-jsNull = JSVal 0-{-# INLINE jsNull #-}--toJSBool :: Bool -> JSVal-toJSBool b = JSVal $ if b then 3 else 2-{-# INLINE toJSBool #-}--jsUndefined :: JSVal-jsUndefined = JSVal 1-{-# INLINE jsUndefined #-}-#endif--isTruthyIO :: JSVal -> JSM Bool-#ifdef ghcjs_HOST_OS-isTruthyIO = return . isTruthy-#else-isTruthyIO (JSVal 0) = return False -- null-isTruthyIO (JSVal 1) = return False -- undefined-isTruthyIO (JSVal 2) = return False -- false-isTruthyIO (JSVal 3) = return True  -- true-isTruthyIO v = withJSVal v $ \rval -> do-                ValueToBoolResult result <- sendCommand (ValueToBool rval)-                return result-#endif-{-# INLINE isTruthyIO #-}--isNullIO :: JSVal -> JSM Bool-#ifdef ghcjs_HOST_OS-isNullIO = return . isNull-#else-isNullIO (JSVal 0) = return True-isNullIO v = withJSVal v $ \rval -> do-                IsNullResult result <- sendCommand $ IsNull rval-                return result-#endif-{-# INLINE isNullIO #-}--isUndefinedIO :: JSVal -> JSM Bool-#ifdef ghcjs_HOST_OS-isUndefinedIO = return . isUndefined-#else-isUndefinedIO (JSVal 1) = return True-isUndefinedIO v = withJSVal v $ \rval -> do-            IsUndefinedResult result <- sendCommand $ IsUndefined rval-            return result-#endif-{-# INLINE isUndefinedIO #-}-

@@ -11,12 +11,7 @@ -----------------------------------------------------------------------------  module Language.Javascript.JSaddle.Native (-    wrapJSVal-  , wrapJSString-  , withJSVal-  , withJSVals-  , withObject-  , withJSString+    module Language.Javascript.JSaddle.Native.Internal   , withToJSVal ) where 

@@ -17,27 +17,46 @@   , withJSVals   , withObject   , withJSString+  , setPropertyByName+  , setPropertyAtIndex+  , stringToValue+  , numberToValue+  , jsonValueToValue+  , getPropertyByName+  , getPropertyAtIndex+  , callAsFunction+  , callAsConstructor+  , newEmptyObject+  , newCallback+  , newArray+  , evaluateScript+  , deRefVal+  , valueToBool+  , valueToNumber+  , valueToString+  , valueToJSON+  , valueToJSONValue+  , isNull+  , isUndefined+  , strictEqual+  , instanceOf+  , propertyNames ) where -import Control.Monad.Trans.Reader (ask) import Control.Monad.IO.Class (MonadIO(..))-import Language.Javascript.JSaddle.Types-       (JSContextRef(..), AsyncCommand(..), JSM(..), JSString(..),-        Object(..), JSVal(..), JSValueReceived(..), JSValueForSend(..),-        JSStringReceived(..), JSStringForSend(..), JSObjectForSend(..))-import System.Mem.Weak (addFinalizer) import Control.Monad.Primitive (touch)-import Control.Monad (when) -wrapJSVal :: JSValueReceived -> JSM JSVal-wrapJSVal (JSValueReceived ref) = do-    -- TODO make sure this ref has not already been wrapped (perhaps only in debug version)-    let result = JSVal ref-    when (ref >= 5) $ do-        ctx <- JSM ask-        liftIO . addFinalizer result $ doSendAsyncCommand ctx $ FreeRef $ JSValueForSend ref-    return result+import Data.Aeson (Value) +import Language.Javascript.JSaddle.Types+       (AsyncCommand(..), JSM(..), JSString(..), addCallback,+        Object(..), JSVal(..), JSValueForSend(..), JSCallAsFunction,+        JSStringReceived(..), JSStringForSend(..), JSObjectForSend(..))+import Language.Javascript.JSaddle.Monad (askJSM)+import Language.Javascript.JSaddle.Run+       (Command(..), AsyncCommand(..), Result(..), sendCommand,+        sendAsyncCommand, sendLazyCommand, wrapJSVal)+ wrapJSString :: MonadIO m => JSStringReceived -> m JSString wrapJSString (JSStringReceived ref) = return $ JSString ref @@ -62,3 +81,149 @@     liftIO $ touch v     return result +setPropertyByName :: JSString -> JSVal -> Object -> JSM ()+setPropertyByName name val this =+    withObject this $ \rthis ->+        withJSString name $ \rname ->+            withJSVal val $ \rval ->+                sendAsyncCommand $ SetPropertyByName rthis rname rval+{-# INLINE setPropertyByName #-}++setPropertyAtIndex :: Int -> JSVal -> Object -> JSM ()+setPropertyAtIndex index val this =+    withObject this $ \rthis ->+        withJSVal val $ \rval ->+            sendAsyncCommand $ SetPropertyAtIndex rthis index rval+{-# INLINE setPropertyAtIndex #-}++stringToValue :: JSString -> JSM JSVal+stringToValue s = withJSString s $ sendLazyCommand . StringToValue+{-# INLINE stringToValue #-}++numberToValue :: Double -> JSM JSVal+numberToValue = sendLazyCommand . NumberToValue+{-# INLINE numberToValue #-}++jsonValueToValue :: Value -> JSM JSVal+jsonValueToValue = sendLazyCommand . JSONValueToValue+{-# INLINE jsonValueToValue #-}++getPropertyByName :: JSString -> Object -> JSM JSVal+getPropertyByName name this =+    withObject this $ \rthis ->+        withJSString name $ sendLazyCommand . GetPropertyByName rthis+{-# INLINE getPropertyByName #-}++getPropertyAtIndex :: Int -> Object -> JSM JSVal+getPropertyAtIndex index this =+    withObject this $ \rthis -> sendLazyCommand $ GetPropertyAtIndex rthis index+{-# INLINE getPropertyAtIndex #-}++callAsFunction :: Object -> Object -> [JSVal] -> JSM JSVal+callAsFunction f this args =+    withObject f $ \rfunction ->+        withObject this $ \rthis ->+            withJSVals args $ sendLazyCommand . CallAsFunction rfunction rthis+{-# INLINE callAsFunction #-}++callAsConstructor :: Object -> [JSVal] -> JSM JSVal+callAsConstructor f args =+    withObject f $ \rfunction ->+        withJSVals args $ sendLazyCommand . CallAsConstructor rfunction+{-# INLINE callAsConstructor #-}++newEmptyObject :: JSM Object+newEmptyObject = Object <$> sendLazyCommand NewEmptyObject+{-# INLINE newEmptyObject #-}++newCallback :: JSCallAsFunction -> JSM Object+newCallback f = do+    object <- Object <$> sendLazyCommand NewCallback+    add <- addCallback <$> askJSM+    liftIO $ add object f+    return object+{-# INLINE newCallback #-}++newArray :: [JSVal] -> JSM JSVal+newArray xs = withJSVals xs $ \xs' -> sendLazyCommand (NewArray xs')+{-# INLINE newArray #-}++evaluateScript :: JSString -> JSM JSVal+evaluateScript script = withJSString script $ sendLazyCommand . EvaluateScript+{-# INLINE evaluateScript #-}++deRefVal :: JSVal -> JSM Result+deRefVal value = withJSVal value $ sendCommand . DeRefVal+{-# INLINE deRefVal #-}++valueToBool :: JSVal -> JSM Bool+valueToBool (JSVal 0) = return False -- null+valueToBool (JSVal 1) = return False -- undefined+valueToBool (JSVal 2) = return False -- false+valueToBool (JSVal 3) = return True  -- true+valueToBool v = withJSVal v $ \rval -> do+    ~(ValueToBoolResult result) <- sendCommand (ValueToBool rval)+    return result+{-# INLINE valueToBool #-}++valueToNumber :: JSVal -> JSM Double+valueToNumber value =+    withJSVal value $ \rval -> do+        ~(ValueToNumberResult result) <- sendCommand (ValueToNumber rval)+        return result+{-# INLINE valueToNumber #-}++valueToString :: JSVal -> JSM JSString+valueToString value = withJSVal value $ \rval -> do+    ~(ValueToStringResult result) <- sendCommand (ValueToString rval)+    wrapJSString result+{-# INLINE valueToString #-}++valueToJSON :: JSVal -> JSM JSString+valueToJSON value = withJSVal value $ \rval -> do+    ~(ValueToJSONResult result) <- sendCommand (ValueToJSON rval)+    wrapJSString result+{-# INLINE valueToJSON #-}++valueToJSONValue :: JSVal -> JSM Value+valueToJSONValue value = withJSVal value $ \rval -> do+    ~(ValueToJSONValueResult result) <- sendCommand (ValueToJSONValue rval)+    return result+{-# INLINE valueToJSONValue #-}++isNull :: JSVal -> JSM Bool+isNull (JSVal 0) = return True+isNull v = withJSVal v $ \rval -> do+    ~(IsNullResult result) <- sendCommand $ IsNull rval+    return result+{-# INLINE isNull #-}++isUndefined :: JSVal -> JSM Bool+isUndefined (JSVal 1) = return True+isUndefined v = withJSVal v $ \rval -> do+    ~(IsUndefinedResult result) <- sendCommand $ IsUndefined rval+    return result+{-# INLINE isUndefined #-}++strictEqual :: JSVal -> JSVal -> JSM Bool+strictEqual a b =+    withJSVal a $ \aref ->+        withJSVal b $ \bref -> do+            ~(StrictEqualResult result) <- sendCommand $ StrictEqual aref bref+            return result+{-# INLINE strictEqual #-}++instanceOf :: JSVal -> Object -> JSM Bool+instanceOf value constructor =+    withJSVal value $ \rval ->+        withObject constructor $ \c' -> do+            ~(InstanceOfResult result) <- sendCommand $ InstanceOf rval c'+            return result+{-# INLINE instanceOf #-}++propertyNames :: Object -> JSM [JSString]+propertyNames this =+    withObject this $ \rthis -> do+        ~(PropertyNamesResult result) <- sendCommand $ PropertyNames rthis+        mapM wrapJSString result+{-# INLINE propertyNames #-}

@@ -113,12 +113,9 @@        (JSString, Object(..),         JSVal(..), JSCallAsFunction) #else-import Data.Text (Text) import GHCJS.Marshal.Internal (ToJSVal(..)) import Language.Javascript.JSaddle.Native-       (withJSVals, withObject)-import Language.Javascript.JSaddle.Run-       (AsyncCommand(..), sendLazyCommand)+       (newCallback, callAsFunction, callAsConstructor) import Language.Javascript.JSaddle.Monad (askJSM, JSM) import Language.Javascript.JSaddle.Types        (JSString, Object(..), SomeJSArray(..),@@ -280,6 +277,7 @@ -- > jsg0 name = jsgf name () -- -- >>> testJSaddle $ jsg0 "globalFunc" >>= valToText+-- A JavaScript exception was thrown! (may not reach Haskell code) -- TypeError:...undefine... jsg0 :: (ToJSString name) => name -> JSM JSVal jsg0 name = jsgf name ()@@ -451,9 +449,7 @@     makeFunctionWithCallback :: Callback (JSVal -> JSVal -> IO ()) -> IO Object #else function f = do-    object <- Object <$> sendLazyCommand NewCallback-    add <- addCallback <$> askJSM-    liftIO $ add object f+    object <- newCallback f     return $ Function object #endif @@ -533,9 +529,7 @@ #else objCallAsFunction f this args = do     rargs <- makeArgs args-    withObject f $ \rfunction ->-        withObject this $ \rthis ->-            withJSVals rargs $ sendLazyCommand . CallAsFunction rfunction rthis+    callAsFunction f this rargs #endif  -- | Call a JavaScript object as a constructor. Consider using 'new'.@@ -577,8 +571,7 @@ #else objCallAsConstructor f args = do     rargs <- makeArgs args-    withObject f $ \rfunction ->-        withJSVals rargs $ sendLazyCommand . CallAsConstructor rfunction+    callAsConstructor f rargs #endif  -- >>> testJSaddle $ strictEqual nullObject (eval "null")

@@ -28,6 +28,7 @@   , sendCommand   , sendLazyCommand   , sendAsyncCommand+  , wrapJSVal #endif ) where @@ -37,10 +38,10 @@        (waitForAnimationFrame) #else import Control.Exception (throwIO)-import Control.Monad (void, forever)+import Control.Monad (void, when, forever, zipWithM_) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Reader (ask, runReaderT)-import Control.Monad.STM (STM, atomically)+import Control.Monad.STM (atomically) import Control.Concurrent (forkIO) import Control.Concurrent.STM.TChan        (tryReadTChan, TChan, readTChan, writeTChan, newTChanIO)@@ -49,16 +50,20 @@ import Control.Concurrent.MVar        (MVar, MVar, putMVar, takeMVar, newEmptyMVar) +import System.IO.Unsafe (unsafeInterleaveIO)+import System.Mem.Weak (addFinalizer)+ import Data.Monoid ((<>)) import qualified Data.Text as T (unpack) import qualified Data.Map as M (lookup, delete, insert, empty) import Data.Time.Clock (getCurrentTime,diffUTCTime)  import Language.Javascript.JSaddle.Types-       (Command(..), AsyncCommand(..), Result(..), JSContextRef(..), JSVal(..),+       (Command(..), AsyncCommand(..), Result(..), Results(..), JSContextRef(..), JSVal(..),         Object(..), JSValueReceived(..), JSM(..), Batch(..), JSValueForSend(..)) import Language.Javascript.JSaddle.Exception (JSException(..))-import Language.Javascript.JSaddle.Native.Internal (wrapJSVal)+-- import Language.Javascript.JSaddle.Native.Internal (wrapJSVal)+import Control.DeepSeq (deepseq) #endif  -- | Forces execution of pending asyncronous code@@ -66,7 +71,9 @@ #ifdef ghcjs_HOST_OS syncPoint = return () #else-syncPoint = void $ sendCommand Sync+syncPoint = do+    SyncResult <- sendCommand Sync+    return () #endif  -- | Forces execution of pending asyncronous code after performing `f`@@ -126,7 +133,7 @@     s <- doSendAsyncCommand <$> JSM ask     liftIO $ s cmd -runJavaScript :: (Batch -> IO ()) -> JSM () -> IO (Result -> IO (), IO ())+runJavaScript :: (Batch -> IO ()) -> JSM () -> IO (Results -> IO (), IO ()) runJavaScript sendBatch entryPoint = do     startTime' <- getCurrentTime     recvChan <- newTChanIO@@ -135,18 +142,19 @@     nextRef' <- newTVarIO 0     let ctx = JSContextRef {         startTime = startTime'-      , doSendCommand = \cmd -> do+      , doSendCommand = \cmd -> cmd `deepseq` do             result <- newEmptyMVar             atomically $ writeTChan commandChan (Right (cmd, result))-            takeMVar result >>= \case-                (ThrowJSValue (JSValueReceived v)) -> throwIO $ JSException (JSVal v)-                r -> return r-      , doSendAsyncCommand = atomically . writeTChan commandChan . Left+            unsafeInterleaveIO $+                takeMVar result >>= \case+                    (ThrowJSValue (JSValueReceived v)) -> throwIO $ JSException (JSVal v)+                    r -> return r+      , doSendAsyncCommand = \cmd -> cmd `deepseq` atomically (writeTChan commandChan $ Left cmd)       , addCallback = \(Object (JSVal val)) cb -> atomically $ modifyTVar callbacks (M.insert val cb)       , freeCallback = \(Object (JSVal val)) -> atomically $ modifyTVar callbacks (M.delete val)       , nextRef = nextRef'       }-    let processResult = \case+    let processResults = \case             (ProtocolError err) -> error $ "Protocol error : " <> T.unpack err             (Callback f this a) -> do                 f'@(JSVal fNumber) <- runReaderT (unJSM $ wrapJSVal f) ctx@@ -157,40 +165,52 @@                     Just cb -> void . forkIO $ runReaderT (unJSM $ cb f' this' args) ctx             m                   -> atomically $ writeTChan recvChan m     _ <- forkIO . forever $ readBatch commandChan >>= \case-            (batch, Just resultMVar) -> do-                sendBatch batch-                atomically (readTChan recvChan) >>= putMVar resultMVar-            (batch, Nothing) -> do+            (batch, resultMVars) -> do                 sendBatch batch                 atomically (readTChan recvChan) >>= \case-                    SyncResult -> return ()-                    ThrowJSValue e -> atomically (discardToSyncPoint commandChan) >>= (`putMVar` ThrowJSValue e)-                    _ -> error "Unexpected result processing batch"-                return ()-    return (processResult, runReaderT (unJSM entryPoint) ctx)+                    Success results -> zipWithM_ putMVar resultMVars results+                    Failure results exception -> do+                        -- The exception will only be rethrown in Haskell if/when one of the+                        -- missing results (if any) is evaluated.+                        putStrLn "A JavaScript exception was thrown! (may not reach Haskell code)"+                        zipWithM_ putMVar resultMVars $ results <> repeat (ThrowJSValue exception)+                    _ -> error "Unexpected jsaddle results"+    return (processResults, runReaderT (unJSM entryPoint) ctx)   where-    readBatch :: TChan (Either AsyncCommand (Command, MVar Result)) -> IO (Batch, Maybe (MVar Result))+    readBatch :: TChan (Either AsyncCommand (Command, MVar Result)) -> IO (Batch, [MVar Result])     readBatch chan = do         first <- atomically $ readTChan chan -- We want at least one command to send-        loop first []+        loop first ([], [])       where-        loop (Left asyncCmd@(SyncWithAnimationFrame _)) asyncCmds =-            atomically (readTChan chan) >>= \cmd -> loopAnimation cmd (asyncCmd:asyncCmds)-        loop (Right (cmd, resultMVar)) asyncCmds =-            return (Batch (reverse asyncCmds) cmd False, Just resultMVar)-        loop (Left asyncCmd) asyncCmds' = do-            let asyncCmds = asyncCmd:asyncCmds'+        loop :: Either AsyncCommand (Command, MVar Result) -> ([Either AsyncCommand Command], [MVar Result]) -> IO (Batch, [MVar Result])+        loop (Left asyncCmd@(SyncWithAnimationFrame _)) (cmds, resultMVars) =+            atomically (readTChan chan) >>= \cmd -> loopAnimation cmd (Left asyncCmd:cmds, resultMVars)+        loop (Right (syncCmd, resultMVar)) (cmds', resultMVars') = do+            let cmds = Right syncCmd:cmds'+                resultMVars = resultMVar:resultMVars'             atomically (tryReadTChan chan) >>= \case-                Nothing -> return (Batch (reverse asyncCmds) Sync False, Nothing)-                Just cmd -> loop cmd asyncCmds+                Nothing -> return (Batch (reverse cmds) False, reverse resultMVars)+                Just cmd -> loop cmd (cmds, resultMVars)+        loop (Left asyncCmd) (cmds', resultMVars) = do+            let cmds = Left asyncCmd:cmds'+            atomically (tryReadTChan chan) >>= \case+                Nothing -> return (Batch (reverse cmds) False, reverse resultMVars)+                Just cmd -> loop cmd (cmds, resultMVars)         -- When we have seen a SyncWithAnimationFrame command only a synchronous command should end the batch-        loopAnimation (Right (cmd, resultMVar)) asyncCmds =-            return (Batch (reverse asyncCmds) cmd True, Just resultMVar)-        loopAnimation (Left asyncCmd) asyncCmds =-            atomically (readTChan chan) >>= \cmd -> loopAnimation cmd (asyncCmd:asyncCmds)-    discardToSyncPoint :: TChan (Either AsyncCommand (Command, MVar Result)) -> STM (MVar Result)-    discardToSyncPoint chan =-        readTChan chan >>= \case-            Right (_, resultMVar) -> return resultMVar-            _                     -> discardToSyncPoint chan+        loopAnimation :: Either AsyncCommand (Command, MVar Result) -> ([Either AsyncCommand Command], [MVar Result]) -> IO (Batch, [MVar Result])+        loopAnimation (Right (Sync, resultMVar)) (cmds, resultMVars) =+            return (Batch (reverse (Right Sync:cmds)) True, reverse (resultMVar:resultMVars))+        loopAnimation (Right (syncCmd, resultMVar)) (cmds, resultMVars) =+            atomically (readTChan chan) >>= \cmd -> loopAnimation cmd (Right syncCmd:cmds, resultMVar:resultMVars)+        loopAnimation (Left asyncCmd) (cmds, resultMVars) =+            atomically (readTChan chan) >>= \cmd -> loopAnimation cmd (Left asyncCmd:cmds, resultMVars)++wrapJSVal :: JSValueReceived -> JSM JSVal+wrapJSVal (JSValueReceived ref) = do+    -- TODO make sure this ref has not already been wrapped (perhaps only in debug version)+    let result = JSVal ref+    when (ref >= 5) $ do+        ctx <- JSM ask+        liftIO . addFinalizer result $ doSendAsyncCommand ctx $ FreeRef $ JSValueForSend ref+    return result #endif

@@ -47,12 +47,15 @@  runBatch :: (ByteString -> ByteString) -> ByteString runBatch send = "\-    \            var processBatch = function(timestamp) {\n\-    \                try {\n\-    \                    var nAsyncLength = batch[0].length;\n\-    \                    for (var nAsync = 0; nAsync != nAsyncLength; nAsync++) {\n\-    \                        var d = batch[0][nAsync];\n\-    \                        switch (d.tag) {\n\+    \    var processBatch = function(timestamp) {\n\+    \        var results = [];\n\+    \        try {\n\+    \            var nCommandsLength = batch[0].length;\n\+    \            for (var nCommand = 0; nCommand != nCommandsLength; nCommand++) {\n\+    \                var cmd = batch[0][nCommand];\n\+    \                if (cmd.Left) {\n\+    \                    var d = cmd.Left;\n\+    \                    switch (d.tag) {\n\     \                            case \"FreeRef\":\n\     \                                jsaddle_values.delete(d.contents);\n\     \                                break;\n\@@ -148,76 +151,79 @@     \                            default:\n\     \                                " <> send "{\"tag\": \"ProtocolError\", \"contents\": e.data}" <> "\n\     \                                return;\n\-    \                        }\n\     \                    }\n\-    \                    var d = batch[1];\n\+    \                } else {\n\+    \                    var d = cmd.Right;\n\     \                    switch (d.tag) {\n\-    \                        case \"ValueToString\":\n\-    \                            var val = jsaddle_values.get(d.contents);\n\-    \                            var s = val === null ? \"null\" : val === undefined ? \"undefined\" : val.toString();\n\-    \                            " <> send "{\"tag\": \"ValueToStringResult\", \"contents\": s}" <> "\n\-    \                            break;\n\-    \                        case \"ValueToBool\":\n\-    \                            " <> send "{\"tag\": \"ValueToBoolResult\", \"contents\": jsaddle_values.get(d.contents) ? true : false}" <> "\n\-    \                            break;\n\-    \                        case \"ValueToNumber\":\n\-    \                            " <> send "{\"tag\": \"ValueToNumberResult\", \"contents\": Number(jsaddle_values.get(d.contents))}" <> "\n\-    \                            break;\n\-    \                        case \"ValueToJSON\":\n\-    \                            var s = jsaddle_values.get(d.contents) === undefined ? \"\" : JSON.stringify(jsaddle_values.get(d.contents));\n\-    \                            " <> send "{\"tag\": \"ValueToJSONResult\", \"contents\": s}" <> "\n\-    \                            break;\n\-    \                        case \"ValueToJSONValue\":\n\-    \                            " <> send "{\"tag\": \"ValueToJSONValueResult\", \"contents\": jsaddle_values.get(d.contents)}" <> "\n\-    \                            break;\n\-    \                        case \"DeRefVal\":\n\-    \                            var n = d.contents;\n\-    \                            var v = jsaddle_values.get(n);\n\-    \                            var c = (v === null           ) ? [0, \"\"] :\n\-    \                                    (v === undefined      ) ? [1, \"\"] :\n\-    \                                    (v === false          ) ? [2, \"\"] :\n\-    \                                    (v === true           ) ? [3, \"\"] :\n\-    \                                    (typeof v === \"number\") ? [-1, v.toString()] :\n\-    \                                    (typeof v === \"string\") ? [-2, v]\n\-    \                                                            : [n, \"\"];\n\-    \                            " <> send "{\"tag\": \"DeRefValResult\", \"contents\": c}" <> "\n\-    \                            break;\n\-    \                        case \"IsNull\":\n\-    \                            " <> send "{\"tag\": \"IsNullResult\", \"contents\": jsaddle_values.get(d.contents) === null}" <> "\n\-    \                            break;\n\-    \                        case \"IsUndefined\":\n\-    \                            " <> send "{\"tag\": \"IsUndefinedResult\", \"contents\": jsaddle_values.get(d.contents) === undefined}" <> "\n\-    \                            break;\n\-    \                        case \"InstanceOf\":\n\-    \                            " <> send "{\"tag\": \"InstanceOfResult\", \"contents\": jsaddle_values.get(d.contents[0]) instanceof jsaddle_values.get(d.contents[1])}" <> "\n\-    \                            break;\n\-    \                        case \"StrictEqual\":\n\-    \                            " <> send "{\"tag\": \"StrictEqualResult\", \"contents\": jsaddle_values.get(d.contents[0]) === jsaddle_values.get(d.contents[1])}" <> "\n\-    \                            break;\n\-    \                        case \"PropertyNames\":\n\-    \                            var result = [];\n\-    \                            for (name in jsaddle_values.get(d.contents)) { result.push(name); }\n\-    \                            " <> send "{\"tag\": \"PropertyNamesResult\", \"contents\": result}" <> "\n\-    \                            break;\n\-    \                        case \"Sync\":\n\-    \                            " <> send "{\"tag\": \"SyncResult\", \"contents\": []}" <> "\n\-    \                            break;\n\-    \                        default:\n\-    \                            " <> send "{\"tag\": \"ProtocolError\", \"contents\": e.data}" <> "\n\-    \                    }\n\-    \                }\n\-    \                catch (err) {\n\-    \                    var n = ++jsaddle_index;\n\-    \                    jsaddle_values.set(n, err);\n\-    \                    " <> send "{\"tag\": \"ThrowJSValue\", \"contents\": n}" <> "\n\+    \                            case \"ValueToString\":\n\+    \                                var val = jsaddle_values.get(d.contents);\n\+    \                                var s = val === null ? \"null\" : val === undefined ? \"undefined\" : val.toString();\n\+    \                                results.push({\"tag\": \"ValueToStringResult\", \"contents\": s});\n\+    \                                break;\n\+    \                            case \"ValueToBool\":\n\+    \                                results.push({\"tag\": \"ValueToBoolResult\", \"contents\": jsaddle_values.get(d.contents) ? true : false});\n\+    \                                break;\n\+    \                            case \"ValueToNumber\":\n\+    \                                results.push({\"tag\": \"ValueToNumberResult\", \"contents\": Number(jsaddle_values.get(d.contents))});\n\+    \                                break;\n\+    \                            case \"ValueToJSON\":\n\+    \                                var s = jsaddle_values.get(d.contents) === undefined ? \"\" : JSON.stringify(jsaddle_values.get(d.contents));\n\+    \                                results.push({\"tag\": \"ValueToJSONResult\", \"contents\": s});\n\+    \                                break;\n\+    \                            case \"ValueToJSONValue\":\n\+    \                                results.push({\"tag\": \"ValueToJSONValueResult\", \"contents\": jsaddle_values.get(d.contents)});\n\+    \                                break;\n\+    \                            case \"DeRefVal\":\n\+    \                                var n = d.contents;\n\+    \                                var v = jsaddle_values.get(n);\n\+    \                                var c = (v === null           ) ? [0, \"\"] :\n\+    \                                        (v === undefined      ) ? [1, \"\"] :\n\+    \                                        (v === false          ) ? [2, \"\"] :\n\+    \                                        (v === true           ) ? [3, \"\"] :\n\+    \                                        (typeof v === \"number\") ? [-1, v.toString()] :\n\+    \                                        (typeof v === \"string\") ? [-2, v]\n\+    \                                                                : [n, \"\"];\n\+    \                                results.push({\"tag\": \"DeRefValResult\", \"contents\": c});\n\+    \                                break;\n\+    \                            case \"IsNull\":\n\+    \                                results.push({\"tag\": \"IsNullResult\", \"contents\": jsaddle_values.get(d.contents) === null});\n\+    \                                break;\n\+    \                            case \"IsUndefined\":\n\+    \                                results.push({\"tag\": \"IsUndefinedResult\", \"contents\": jsaddle_values.get(d.contents) === undefined});\n\+    \                                break;\n\+    \                            case \"InstanceOf\":\n\+    \                                results.push({\"tag\": \"InstanceOfResult\", \"contents\": jsaddle_values.get(d.contents[0]) instanceof jsaddle_values.get(d.contents[1])});\n\+    \                                break;\n\+    \                            case \"StrictEqual\":\n\+    \                                results.push({\"tag\": \"StrictEqualResult\", \"contents\": jsaddle_values.get(d.contents[0]) === jsaddle_values.get(d.contents[1])});\n\+    \                                break;\n\+    \                            case \"PropertyNames\":\n\+    \                                var result = [];\n\+    \                                for (name in jsaddle_values.get(d.contents)) { result.push(name); }\n\+    \                                results.push({\"tag\": \"PropertyNamesResult\", \"contents\": result});\n\+    \                                break;\n\+    \                            case \"Sync\":\n\+    \                                results.push({\"tag\": \"SyncResult\", \"contents\": []});\n\+    \                                break;\n\+    \                            default:\n\+    \                                results.push({\"tag\": \"ProtocolError\", \"contents\": e.data});\n\+    \                        }\n\     \                }\n\-    \            };\n\-    \            if(batch[2]) {\n\-    \                window.requestAnimationFrame(processBatch);\n\     \            }\n\-    \            else {\n\-    \                processBatch(window.performance ? window.performance.now() : null);\n\-    \            }\n\+    \            " <> send "{\"tag\": \"Success\", \"contents\": results}" <> "\n\+    \        }\n\+    \        catch (err) {\n\+    \            var n = ++jsaddle_index;\n\+    \            jsaddle_values.set(n, err);\n\+    \            " <> send "{\"tag\": \"Failure\", \"contents\": [results,n]}" <> "\n\+    \        }\n\+    \    };\n\+    \    if(batch[1]) {\n\+    \        window.requestAnimationFrame(processBatch);\n\+    \    }\n\+    \    else {\n\+    \        processBatch(window.performance ? window.performance.now() : null);\n\+    \    }\n\     \"  -- Use this to generate this string for embedding@@ -322,5 +328,59 @@     \        }\n\     \    }\n\     \\n\+    \}\n\+    \function h$roundUpToMultipleOf(n,m) {\n\+    \  var rem = n % m;\n\+    \  return rem === 0 ? n : n - rem + m;\n\+    \}\n\+    \\n\+    \function h$newByteArray(len) {\n\+    \  var len0 = Math.max(h$roundUpToMultipleOf(len, 8), 8);\n\+    \  var buf = new ArrayBuffer(len0);\n\+    \  return { buf: buf\n\+    \         , len: len\n\+    \         , i3: new Int32Array(buf)\n\+    \         , u8: new Uint8Array(buf)\n\+    \         , u1: new Uint16Array(buf)\n\+    \         , f3: new Float32Array(buf)\n\+    \         , f6: new Float64Array(buf)\n\+    \         , dv: new DataView(buf)\n\+    \         }\n\+    \}\n\+    \function h$wrapBuffer(buf, unalignedOk, offset, length) {\n\+    \  if(!unalignedOk && offset && offset % 8 !== 0) {\n\+    \    throw (\"h$wrapBuffer: offset not aligned:\" + offset);\n\+    \  }\n\+    \  if(!buf || !(buf instanceof ArrayBuffer))\n\+    \    throw \"h$wrapBuffer: not an ArrayBuffer\"\n\+    \  if(!offset) { offset = 0; }\n\+    \  if(!length || length < 0) { length = buf.byteLength - offset; }\n\+    \  return { buf: buf\n\+    \         , len: length\n\+    \         , i3: (offset%4) ? null : new Int32Array(buf, offset, length >> 2)\n\+    \         , u8: new Uint8Array(buf, offset, length)\n\+    \         , u1: (offset%2) ? null : new Uint16Array(buf, offset, length >> 1)\n\+    \         , f3: (offset%4) ? null : new Float32Array(buf, offset, length >> 2)\n\+    \         , f6: (offset%8) ? null : new Float64Array(buf, offset, length >> 3)\n\+    \         , dv: new DataView(buf, offset, length)\n\+    \         };\n\+    \}\n\+    \function h$newByteArrayFromBase64String(base64) {\n\+    \  var bin = window.atob(base64);\n\+    \  var ba = h$newByteArray(bin.length);\n\+    \  var u8 = ba.u8;\n\+    \  for (var i = 0; i < bin.length; i++) {\n\+    \    u8[i] = bin.charCodeAt(i);\n\+    \  }\n\+    \  return ba;\n\+    \}\n\+    \function h$byteArrayToBase64String(off, len, ba) {\n\+    \  var bin = '';\n\+    \  var u8 = ba.u8;\n\+    \  var end = off + len;\n\+    \  for (var i = off; i < end; i++) {\n\+    \    bin += String.fromCharCode(u8[i]);\n\+    \  }\n\+    \  return window.btoa(bin);\n\     \}\n\     \"

@@ -7,11 +7,11 @@ {-# LANGUAGE UndecidableInstances       #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE DefaultSignatures          #-} {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE KindSignatures             #-} {-# LANGUAGE PolyKinds                  #-} {-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE DefaultSignatures          #-} #endif ----------------------------------------------------------------------------- --@@ -34,11 +34,20 @@   , MonadJSM(..)   , liftJSM +  -- * Pure GHCJS functions+  , GHCJSPure(..)+  , ghcjsPure+  , ghcjsPureMap+  , ghcjsPureId+   -- * JavaScript Value Types   , JSVal(..)+  , IsJSVal(..)+  , jsval   , SomeJSArray(..)   , JSArray   , MutableJSArray+  , STJSArray   , Object(..)   , JSString(..)   , Nullable(..)@@ -46,6 +55,11 @@    -- * JavaScript Context Commands #ifndef ghcjs_HOST_OS+  , MutabilityType(..)+  , Mutable+  , Immutable+  , IsItMutable(..)+  , Mutability   , JSValueReceived(..)   , JSValueForSend(..)   , JSStringReceived(..)@@ -55,6 +69,7 @@   , Command(..)   , Batch(..)   , Result(..)+  , Results(..) #endif ) where @@ -62,9 +77,11 @@ #ifdef ghcjs_HOST_OS import GHCJS.Types import JavaScript.Object.Internal (Object(..))-import JavaScript.Array.Internal (SomeJSArray(..), JSArray, MutableJSArray)+import JavaScript.Array.Internal (SomeJSArray(..), JSArray, MutableJSArray, STJSArray) import GHCJS.Nullable (Nullable(..)) #else+import GHCJS.Prim.Internal (JSVal(..), JSValueRef)+import Data.JSString.Internal.Type (JSString(..)) import Control.DeepSeq (NFData(..)) import Control.Monad.Trans.Reader (ReaderT(..)) import Control.Monad.Trans.State.Lazy (StateT(..))@@ -74,11 +91,10 @@ import Control.Monad.Fix (MonadFix) import Control.Monad.Ref (MonadAtomicRef(..), MonadRef(..)) import Control.Concurrent.STM.TVar (TVar)-import Data.Coerce (Coercible, coerce)-import Data.Int (Int64) import Data.Text (Text) import Data.Time.Clock (UTCTime(..)) import Data.Typeable (Typeable)+import Data.Coerce (coerce, Coercible) import Data.Aeson        (defaultOptions, genericToEncoding, ToJSON(..), FromJSON(..), Value) import GHC.Generics (Generic)@@ -116,6 +132,47 @@     deriving (Functor, Applicative, Monad, MonadIO, MonadFix) #endif ++-- | Type we can give to functions that are pure when using ghcjs, but+--   live in JSM when using jsaddle.+--+--   Some functions that can be pure in GHCJS cannot be implemented in+--   a pure way in JSaddle (because we need to know the JSContextRef).+--   Instead we implement versions of these functions in that return+--   `GHCJSPure a` instead of `a`.  To call them in a way that will+--   work when compiling with GHCJS use `ghcjsPure`.+#ifdef ghcjs_HOST_OS+type GHCJSPure a = a+#else+newtype GHCJSPure a = GHCJSPure (JSM a)+#endif++-- | Used when you want to call a functions that is pure in GHCJS, but+--   lives in the JSM in jsaddle.+ghcjsPure :: GHCJSPure a -> JSM a+#ifdef ghcjs_HOST_OS+ghcjsPure = pure+#else+ghcjsPure (GHCJSPure x) = x+#endif+{-# INLINE ghcjsPure #-}++ghcjsPureMap :: (a -> b) -> GHCJSPure a -> GHCJSPure b+#ifdef ghcjs_HOST_OS+ghcjsPureMap = id+#else+ghcjsPureMap f (GHCJSPure x) = GHCJSPure (f <$> x)+#endif+{-# INLINE ghcjsPureMap #-}++ghcjsPureId :: a -> GHCJSPure a+#ifdef ghcjs_HOST_OS+ghcjsPureId = id+#else+ghcjsPureId = GHCJSPure . return+#endif+{-# INLINE ghcjsPureId #-}+ -- | The 'MonadJSM' is to 'JSM' what 'MonadIO' is to 'IO'. --   When using GHCJS it is 'MonadIO'. #ifdef ghcjs_HOST_OS@@ -172,23 +229,15 @@                                    --   as an argument and invoke it from haskell.  #ifndef ghcjs_HOST_OS--- A reference to a particular JavaScript value inside the JavaScript context-type JSValueRef = Int64 --- | See 'GHCJS.Prim.JSVal'-newtype JSVal = JSVal JSValueRef deriving(Show, ToJSON, FromJSON)--instance NFData JSVal where-  rnf x = x `seq` ()- class IsJSVal a where-  jsval_ :: a -> JSVal+  jsval_ :: a -> GHCJSPure JSVal -  default jsval_ :: Coercible a JSVal => a -> JSVal-  jsval_ = coerce+  default jsval_ :: Coercible a JSVal => a -> GHCJSPure JSVal+  jsval_ = GHCJSPure . return . coerce   {-# INLINE jsval_ #-} -jsval :: IsJSVal a => a -> JSVal+jsval :: IsJSVal a => a -> GHCJSPure JSVal jsval = jsval_ {-# INLINE jsval #-} @@ -209,35 +258,39 @@  newtype SomeJSArray (m :: MutabilityType s) = SomeJSArray JSVal   deriving (Typeable)+instance IsJSVal (SomeJSArray m)  -- | See 'JavaScript.Array.Internal.JSArray' type JSArray        = SomeJSArray Immutable -- | See 'JavaScript.Array.Internal.MutableJSArray' type MutableJSArray = SomeJSArray Mutable +-- | See 'JavaScript.Array.Internal.STJSArray'+type STJSArray s    = SomeJSArray (STMutable s)+ -- | See 'JavaScript.Object.Internal.Object' newtype Object = Object JSVal deriving(Show, ToJSON, FromJSON)  -- | See 'GHCJS.Nullable.Nullable' newtype Nullable a = Nullable a --- | See 'Data.JSString.Internal.Type'-newtype JSString = JSString Text deriving(Show, ToJSON, FromJSON)- -- | Wrapper used when receiving a 'JSVal' from the JavaScript context newtype JSValueReceived = JSValueReceived JSValueRef deriving(Show, ToJSON, FromJSON)  -- | Wrapper used when sending a 'JSVal' to the JavaScript context-newtype JSValueForSend = JSValueForSend JSValueRef deriving(Show, ToJSON, FromJSON)+newtype JSValueForSend = JSValueForSend JSValueRef deriving(Show, ToJSON, FromJSON, Generic)+instance NFData JSValueForSend  -- | Wrapper used when sending a 'Object' to the JavaScript context-newtype JSObjectForSend = JSObjectForSend JSValueForSend deriving(Show, ToJSON, FromJSON)+newtype JSObjectForSend = JSObjectForSend JSValueForSend deriving(Show, ToJSON, FromJSON, Generic)+instance NFData JSObjectForSend  -- | Wrapper used when receiving a 'JSString' from the JavaScript context newtype JSStringReceived = JSStringReceived Text deriving(Show, ToJSON, FromJSON)  -- | Wrapper used when sending a 'JString' to the JavaScript context-newtype JSStringForSend = JSStringForSend Text deriving(Show, ToJSON, FromJSON)+newtype JSStringForSend = JSStringForSend Text deriving(Show, ToJSON, FromJSON, Generic)+instance NFData JSStringForSend  -- | Command sent to a JavaScript context for execution asynchronously data AsyncCommand = FreeRef JSValueForSend@@ -255,13 +308,15 @@                   | NewArray [JSValueForSend] JSValueForSend                   | EvaluateScript JSStringForSend JSValueForSend                   | SyncWithAnimationFrame JSValueForSend-             deriving (Show, Generic)+                  deriving (Show, Generic)  instance ToJSON AsyncCommand where     toEncoding = genericToEncoding defaultOptions  instance FromJSON AsyncCommand +instance NFData AsyncCommand+ -- | Command sent to a JavaScript context for execution synchronously data Command = DeRefVal JSValueForSend              | ValueToBool JSValueForSend@@ -282,8 +337,10 @@  instance FromJSON Command +instance NFData Command+ -- | Batch of commands that can be sent together to the JavaScript context-data Batch = Batch [AsyncCommand] Command Bool+data Batch = Batch [Either AsyncCommand Command] Bool              deriving (Show, Generic)  instance ToJSON Batch where@@ -291,6 +348,8 @@  instance FromJSON Batch +instance NFData Batch+ -- | Result of a 'Command' returned from the JavaScript context data Result = DeRefValResult JSValueRef Text             | ValueToBoolResult Bool@@ -302,17 +361,26 @@             | IsUndefinedResult Bool             | StrictEqualResult Bool             | InstanceOfResult Bool-            | Callback JSValueReceived JSValueReceived [JSValueReceived]             | PropertyNamesResult [JSStringReceived]             | ThrowJSValue JSValueReceived-            | ProtocolError Text             | SyncResult-             deriving (Show, Generic)+            deriving (Show, Generic)  instance ToJSON Result where     toEncoding = genericToEncoding defaultOptions  instance FromJSON Result++data Results = Success [Result]+             | Failure [Result] JSValueReceived+             | Callback JSValueReceived JSValueReceived [JSValueReceived]+             | ProtocolError Text+             deriving (Show, Generic)++instance ToJSON Results where+    toEncoding = genericToEncoding defaultOptions++instance FromJSON Results #endif  

@@ -45,7 +45,7 @@   , showJSValue    -- * Converting JavaScript values-  , isTruthyIO+  , isTruthy   , valToBool   , valToNumber   , valToStr@@ -57,11 +57,11 @@   , val   , jsNull   , valNull-  , isNullIO+  , isNull   , valIsNull   , jsUndefined   , valUndefined-  , isUndefinedIO+  , isUndefined   , valIsUndefined   , maybeNullOrUndefined   , maybeNullOrUndefined'@@ -84,32 +84,32 @@ import Data.Text (Text) import qualified Data.Text as T (pack, unpack) import Data.Aeson (Value)+import Data.JSString.Text (textToJSString)  #ifdef ghcjs_HOST_OS import Language.Javascript.JSaddle.Types-       (Object(..), JSString(..), JSVal(..))+       (Object(..), JSString(..), JSVal(..), ghcjsPure) import GHCJS.Marshal (ToJSVal(..)) import GHCJS.Marshal.Pure (pToJSVal)-import Data.JSString.Text (textToJSString) #else import Data.Char (chr, ord) import Data.Word (Word, Word8, Word16, Word32) import Data.Int (Int8, Int16, Int32) import GHCJS.Marshal.Internal (ToJSVal(..), FromJSVal(..)) import Language.Javascript.JSaddle.Types-       (Object(..), JSString(..), JSVal(..), JSValueForSend(..))+       (Object(..), JSString(..), JSVal(..), ghcjsPure) import Language.Javascript.JSaddle.Native-       (wrapJSString, withJSVal, withObject, withJSString, withToJSVal)-import Language.Javascript.JSaddle.Run-       (Command(..), AsyncCommand(..), Result(..), sendCommand,-        sendLazyCommand)+       (valueToNumber, valueToString, valueToJSON, numberToValue, stringToValue, jsonValueToValue)+import qualified Language.Javascript.JSaddle.Native as N+       (deRefVal, strictEqual, instanceOf)+import Language.Javascript.JSaddle.Run (Result(..)) #endif import Language.Javascript.JSaddle.Monad (JSM) import Language.Javascript.JSaddle.Classes        (MakeObject(..), MakeArgs(..)) import Language.Javascript.JSaddle.Marshal.String (ToJSString(..), FromJSString(..)) import Language.Javascript.JSaddle.String (strToText, textToStr)-import Language.Javascript.JSaddle.Foreign (jsTrue, jsFalse, jsNull, toJSBool, jsUndefined, isTruthyIO, isNullIO, isUndefinedIO)+import GHCJS.Foreign.Internal (jsTrue, jsFalse, jsNull, toJSBool, jsUndefined, isTruthy, isNull, isUndefined)  -- $setup -- >>> import Language.Javascript.JSaddle.Test (testJSaddle)@@ -166,7 +166,7 @@ -- >>> testJSaddle $ valToBool "1" -- true valToBool :: ToJSVal value => value -> JSM Bool-valToBool value = toJSVal value >>= isTruthyIO+valToBool value = toJSVal value >>= ghcjsPure . isTruthy  -- | Given a JavaScript value get its numeric value. --   May throw JSException.@@ -192,10 +192,7 @@ valToNumber value = jsrefToNumber <$> toJSVal value foreign import javascript unsafe "$r = Number($1);" jsrefToNumber :: JSVal -> Double #else-valToNumber value =-    withToJSVal value $ \rval -> do-        ValueToNumberResult result <- sendCommand (ValueToNumber rval)-        return result+valToNumber value = toJSVal value >>= valueToNumber #endif  -- | Given a JavaScript value get its string value (as a JavaScript string).@@ -222,10 +219,7 @@ valToStr value = jsrefToString <$> toJSVal value foreign import javascript unsafe "$r = $1.toString();" jsrefToString :: JSVal -> JSString #else-valToStr value =-    withToJSVal value $ \rval -> do-        ValueToStringResult result <- sendCommand (ValueToString rval)-        wrapJSString result+valToStr value = toJSVal value >>= valueToString #endif  -- | Given a JavaScript value get its string value (as a Haskell 'Text').@@ -276,10 +270,7 @@ valToJSON value = jsrefToJSON <$> toJSVal value foreign import javascript unsafe "$r = $1 === undefined ? \"\" : JSON.stringify($1);" jsrefToJSON :: JSVal -> JSString #else-valToJSON value =-    withToJSVal value $ \rval -> do-        ValueToJSONResult result <- sendCommand (ValueToJSON rval)-        wrapJSString result+valToJSON value = toJSVal value >>= valueToJSON #endif  -- | Given a JavaScript value get its object value.@@ -305,7 +296,7 @@ valToObject value = Object <$> toJSVal value  instance MakeObject JSVal where-    makeObject = valToObject+    makeObject = return . Object  instance ToJSVal Object where     toJSVal (Object r) = return r@@ -356,16 +347,16 @@     {-# INLINE toJSVal #-} instance FromJSVal a => FromJSVal (Maybe a) where     fromJSValUnchecked x =-        isUndefinedIO x >>= \case+        ghcjsPure (isUndefined x) >>= \case             True  -> return Nothing-            False -> isNullIO x >>= \case+            False -> ghcjsPure (isNull x) >>= \case                     True  -> return Nothing                     False -> fromJSVal x     {-# INLINE fromJSValUnchecked #-}     fromJSVal x =-        isUndefinedIO x >>= \case+        ghcjsPure (isUndefined x) >>= \case             True  -> return (Just Nothing)-            False -> isNullIO x >>= \case+            False -> ghcjsPure (isNull x) >>= \case                     True  -> return (Just Nothing)                     False -> fmap (fmap Just) fromJSVal x     {-# INLINE fromJSVal #-}@@ -382,7 +373,7 @@  -- | Test a JavaScript value to see if it is @null@ valIsNull :: ToJSVal value => value -> JSM Bool-valIsNull value = toJSVal value >>= isNullIO+valIsNull value = toJSVal value >>= ghcjsPure . isNull  ----------- undefined --------------- -- | An @undefined@ JavaScript value@@ -405,26 +396,26 @@  -- | Test a JavaScript value to see if it is @undefined@ valIsUndefined :: ToJSVal value => value -> JSM Bool-valIsUndefined value = toJSVal value >>= isUndefinedIO+valIsUndefined value = toJSVal value >>= ghcjsPure . isUndefined  -- | Convert a JSVal to a Maybe JSVal (converting null and undefined to Nothing) maybeNullOrUndefined :: ToJSVal value => value -> JSM (Maybe JSVal) maybeNullOrUndefined value = do     rval <- toJSVal value-    valIsNull rval >>= \case+    ghcjsPure (isNull rval) >>= \case         True -> return Nothing         _    ->-            valIsUndefined rval >>= \case+            ghcjsPure (isUndefined rval) >>= \case                 True -> return Nothing                 _    -> return (Just rval)  maybeNullOrUndefined' :: ToJSVal value => (JSVal -> JSM a) -> value -> JSM (Maybe a) maybeNullOrUndefined' f value = do     rval <- toJSVal value-    valIsNull rval >>= \case+    ghcjsPure (isNull rval) >>= \case         True -> return Nothing         _    ->-            valIsUndefined rval >>= \case+            ghcjsPure (isUndefined rval) >>= \case                 True -> return Nothing                 _    -> Just <$> f rval @@ -448,52 +439,49 @@ ----------- numbers --------------- -- | Make a JavaScript number valMakeNumber :: Double -> JSM JSVal-#ifdef ghcjs_HOST_OS-valMakeNumber n = toJSVal n-#else-valMakeNumber = sendLazyCommand . NumberToValue-#endif+valMakeNumber = toJSVal+{-# INLINE valMakeNumber #-}  #ifndef ghcjs_HOST_OS -- | Makes a JavaScript number instance ToJSVal Double where-    toJSVal = valMakeNumber+    toJSVal = numberToValue     {-# INLINE toJSVal #-}  instance ToJSVal Float where-    toJSVal = valMakeNumber . realToFrac+    toJSVal = numberToValue . realToFrac     {-# INLINE toJSVal #-}  instance ToJSVal Word where-    toJSVal = valMakeNumber . fromIntegral+    toJSVal = numberToValue . fromIntegral     {-# INLINE toJSVal #-}  instance ToJSVal Word8 where-    toJSVal = valMakeNumber . fromIntegral+    toJSVal = numberToValue . fromIntegral     {-# INLINE toJSVal #-}  instance ToJSVal Word16 where-    toJSVal = valMakeNumber . fromIntegral+    toJSVal = numberToValue . fromIntegral     {-# INLINE toJSVal #-}  instance ToJSVal Word32 where-    toJSVal = valMakeNumber . fromIntegral+    toJSVal = numberToValue . fromIntegral     {-# INLINE toJSVal #-}  instance ToJSVal Int where-    toJSVal = valMakeNumber . fromIntegral+    toJSVal = numberToValue . fromIntegral     {-# INLINE toJSVal #-}  instance ToJSVal Int8 where-    toJSVal = valMakeNumber . fromIntegral+    toJSVal = numberToValue . fromIntegral     {-# INLINE toJSVal #-}  instance ToJSVal Int16 where-    toJSVal = valMakeNumber . fromIntegral+    toJSVal = numberToValue . fromIntegral     {-# INLINE toJSVal #-}  instance ToJSVal Int32 where-    toJSVal = valMakeNumber . fromIntegral+    toJSVal = numberToValue . fromIntegral     {-# INLINE toJSVal #-} #endif @@ -503,25 +491,18 @@  -- | Make a JavaScript string from `Text` valMakeText :: Text -> JSM JSVal-#ifdef ghcjs_HOST_OS-valMakeText = return . pToJSVal . textToJSString-#else-valMakeText text = valMakeString (textToStr text)-#endif+valMakeText = toJSVal . textToJSString+{-# INLINE valMakeText #-}  -- | Make a JavaScript string from `JSString` valMakeString :: JSString -> JSM JSVal-#ifdef ghcjs_HOST_OS-valMakeString = return . pToJSVal-#else-valMakeString s =-    withJSString s $ sendLazyCommand . StringToValue-#endif+valMakeString = toJSVal+{-# INLINE valMakeString #-}  #ifndef ghcjs_HOST_OS -- | Makes a JavaScript string instance ToJSVal Text where-    toJSVal = valMakeText+    toJSVal = stringToValue . JSString     {-# INLINE toJSVal #-} instance FromJSVal Text where     fromJSValUnchecked = valToText@@ -537,7 +518,7 @@ #ifndef ghcjs_HOST_OS -- | Makes a JavaScript string instance ToJSVal JSString where-    toJSVal = valMakeString+    toJSVal = stringToValue     {-# INLINE toJSVal #-} instance FromJSVal JSString where     fromJSValUnchecked = valToStr@@ -584,16 +565,12 @@  -- | Make a JavaScript string from AESON `Value` valMakeJSON :: Value -> JSM JSVal-#ifdef ghcjs_HOST_OS valMakeJSON = toJSVal-#else-valMakeJSON = sendLazyCommand . JSONValueToValue-#endif  #ifndef ghcjs_HOST_OS -- | Makes a JSON value instance ToJSVal Value where-    toJSVal = valMakeJSON+    toJSVal = jsonValueToValue     {-# INLINE toJSVal #-} #endif @@ -642,18 +619,16 @@                                        (typeof $1===\"string\")?4:\                                        (typeof $1===\"object\")?5:-1;" jsrefGetType :: JSVal -> Int #else-deRefVal value = do-    v <- toJSVal value-    withJSVal v $ \rval ->-        sendCommand (DeRefVal rval) >>= \case-            DeRefValResult 0    _ -> return   ValNull-            DeRefValResult 1    _ -> return   ValUndefined-            DeRefValResult 2    _ -> return $ ValBool False-            DeRefValResult 3    _ -> return $ ValBool True-            DeRefValResult (-1) s -> return $ ValNumber (read (T.unpack s))-            DeRefValResult (-2) s -> return $ ValString s-            DeRefValResult ref  _ -> return $ ValObject (Object (JSVal ref))-            _                     -> error "Unexpected result dereferencing JSaddle value"+deRefVal value = toJSVal value >>= N.deRefVal >>= \result -> return $+    case result of+        DeRefValResult 0    _ -> ValNull+        DeRefValResult 1    _ -> ValUndefined+        DeRefValResult 2    _ -> ValBool False+        DeRefValResult 3    _ -> ValBool True+        DeRefValResult (-1) s -> ValNumber (read (T.unpack s))+        DeRefValResult (-2) s -> ValString s+        DeRefValResult ref  _ -> ValObject (Object (JSVal ref))+        _                     -> error "Unexpected result dereferencing JSaddle value" #endif  -- | Make a JavaScript value out of a 'JSValue' ADT.@@ -712,10 +687,7 @@ #ifdef ghcjs_HOST_OS     return $ jsvalueisstrictequal aval bval #else-    withJSVal aval $ \aref ->-        withJSVal bval $ \bref -> do-            StrictEqualResult result <- sendCommand $ StrictEqual aref bref-            return result+    N.strictEqual aval bval #endif  #ifdef ghcjs_HOST_OS@@ -733,10 +705,7 @@ #ifdef ghcjs_HOST_OS     return $ js_isInstanceOf v c #else-    withJSVal v $ \rval ->-        withObject c $ \c' -> do-            InstanceOfResult result <- sendCommand $ InstanceOf rval c'-            return result+    N.instanceOf v c #endif