diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,13 @@ +# Revision history for ghcjs-base + +## 0.8.1.0 + +* `GHCJS.Int53`: `Int53` and `Word53`, integers a JavaScript Number holds + exactly (up to 2^53 - 1), with checked (`toInt53`), saturating + (`clampInt53`) and literal (`int53`) conversions and no `Num` instance. + jsaddle has the same module for native GHC. +* `PToJSVal`, `PFromJSVal`, `ToJSVal` and `FromJSVal` instances for + `Object` and `SomeJSArray` (`JSArray`, `MutableJSArray`) in + `GHCJS.Marshal.Internal`; `fromJSVal` is `Nothing` for `null` and + `undefined`. Packages with their own orphan instances for these types + need to drop them. diff --git a/GHCJS/Int53.hs b/GHCJS/Int53.hs new file mode 100644 --- /dev/null +++ b/GHCJS/Int53.hs @@ -0,0 +1,184 @@ +----------------------------------------------------------------------------- +-- +-- Module : GHCJS.Int53 +-- License : MIT +-- +-- | Integers that a JavaScript Number holds exactly. +-- +-- A JavaScript Number is a double, so it represents every integer of +-- magnitude up to @2^53 - 1@ (@Number.MAX_SAFE_INTEGER@) exactly and loses +-- precision beyond that. Web IDL's @long long@ and @unsigned long long@ +-- are such Numbers (its editors have proposed renaming them @int53@ / +-- @uint53@, ), and without +-- @[EnforceRange]@ a browser silently reduces an out of range argument +-- modulo @2^64@. +-- +-- 'Int53' and 'Word53' make that range part of the type. They have no +-- 'Num' instance on purpose: do arithmetic in 'Int64', 'Integer', 'Double' +-- or any other numeric type and convert back with a checked conversion, +-- so the place where a value could go out of range is explicit. +-- +-- Using them with the DOM bindings (jsaddle-dom / ghcjs-dom 0.10, where +-- every @long long@ is an 'Int53' and every @unsigned long long@ a +-- 'Word53'): +-- +-- > size <- Blob.getSize blob -- Word53 +-- > let half = fromWord53 size `div` (2 :: Integer) +-- > -- (toInt53 gives Maybe Int53: Nothing when out of range) +-- > part <- Blob.slice blob (Just (int53 0)) (toInt53 half) (Nothing :: Maybe Text) +-- +-- Small literals go through 'int53' / 'word53' (every 'Int32' / 'Word32' +-- fits); computed values through 'toInt53' / 'toWord53' (or 'clampInt53' +-- / 'clampWord53' to saturate instead). +-- +-- jsaddle provides a module with the same name and API for native GHC +-- (@Language.Javascript.JSaddle.Int53@ re-exports whichever applies); keep +-- the two in step. +-- +----------------------------------------------------------------------------- +module GHCJS.Int53 ( + -- * Signed + Int53 + , int53 + , toInt53 + , clampInt53 + , fromInt53 + , minInt53 + , maxInt53 + -- * Unsigned + , Word53 + , word53 + , toWord53 + , clampWord53 + , fromWord53 + , maxWord53 +) where + +import Data.Int (Int32, Int64) +import Data.Word (Word32, Word64) + +import GHCJS.Marshal (ToJSVal(..), FromJSVal(..)) +import GHCJS.Marshal.Pure (PToJSVal(..), PFromJSVal(..)) + +-- | An integer in the range @[-(2^53 - 1), 2^53 - 1]@. +newtype Int53 = Int53 Int64 deriving (Eq, Ord) + +-- | An integer in the range @[0, 2^53 - 1]@. +newtype Word53 = Word53 Word64 deriving (Eq, Ord) + +-- | @2^53 - 1@ (@Number.MAX_SAFE_INTEGER@) +safeMax :: Integer +safeMax = 2 ^ (53 :: Int) - 1 + +minInt53, maxInt53 :: Int53 +minInt53 = Int53 (fromInteger (negate safeMax)) +maxInt53 = Int53 (fromInteger safeMax) + +maxWord53 :: Word53 +maxWord53 = Word53 (fromInteger safeMax) + +instance Bounded Int53 where + minBound = minInt53 + maxBound = maxInt53 + +instance Bounded Word53 where + minBound = Word53 0 + maxBound = maxWord53 + +-- | Shown (and read) as a plain number. +instance Show Int53 where + showsPrec p (Int53 i) = showsPrec p i + +instance Show Word53 where + showsPrec p (Word53 w) = showsPrec p w + +instance Read Int53 where + readsPrec p s = [ (x, rest) | (i, rest) <- readsPrec p s, Just x <- [toInt53 (i :: Integer)] ] + +instance Read Word53 where + readsPrec p s = [ (x, rest) | (i, rest) <- readsPrec p s, Just x <- [toWord53 (i :: Integer)] ] + +-- | Every 'Int32' fits (use it for literals: @int53 0@). +int53 :: Int32 -> Int53 +int53 = Int53 . fromIntegral + +-- | Every 'Word32' fits (use it for literals: @word53 0@). +word53 :: Word32 -> Word53 +word53 = Word53 . fromIntegral + +-- | 'Nothing' when out of range. +toInt53 :: Integral a => a -> Maybe Int53 +toInt53 a + | abs i <= safeMax = Just (Int53 (fromInteger i)) + | otherwise = Nothing + where i = toInteger a + +-- | 'Nothing' when out of range. +toWord53 :: Integral a => a -> Maybe Word53 +toWord53 a + | i >= 0 && i <= safeMax = Just (Word53 (fromInteger i)) + | otherwise = Nothing + where i = toInteger a + +-- | Saturating conversion (like Web IDL's @[Clamp]@, without rounding). +clampInt53 :: Integral a => a -> Int53 +clampInt53 a = Int53 (fromInteger (max (negate safeMax) (min safeMax (toInteger a)))) + +-- | Saturating conversion (like Web IDL's @[Clamp]@, without rounding). +clampWord53 :: Integral a => a -> Word53 +clampWord53 a = Word53 (fromInteger (max 0 (min safeMax (toInteger a)))) + +-- | Always exact for 'Int64', 'Integer' and 'Double' (and for any type +-- wide enough for the value). +fromInt53 :: Num b => Int53 -> b +fromInt53 (Int53 i) = fromIntegral i + +-- | Always exact for 'Word64', 'Int64', 'Integer' and 'Double' (and for any +-- type wide enough for the value). +fromWord53 :: Num b => Word53 -> b +fromWord53 (Word53 w) = fromIntegral w + +fromDouble :: (Integer -> Maybe a) -> Double -> Maybe a +fromDouble f d + | isNaN d || isInfinite d = Nothing + | fromInteger i == d = f i + | otherwise = Nothing + where i = truncate d + +-- | A JavaScript Number (exact). +instance PToJSVal Int53 where + pToJSVal (Int53 i) = pToJSVal (fromIntegral i :: Double) + {-# INLINE pToJSVal #-} + +-- | A JavaScript Number (exact). +instance PToJSVal Word53 where + pToJSVal (Word53 w) = pToJSVal (fromIntegral w :: Double) + {-# INLINE pToJSVal #-} + +-- | Unchecked: truncates (and saturates) whatever Number it is given. +instance PFromJSVal Int53 where + pFromJSVal v = clampInt53 (truncate (pFromJSVal v :: Double) :: Integer) + {-# INLINE pFromJSVal #-} + +-- | Unchecked: truncates (and saturates) whatever Number it is given. +instance PFromJSVal Word53 where + pFromJSVal v = clampWord53 (truncate (pFromJSVal v :: Double) :: Integer) + {-# INLINE pFromJSVal #-} + +instance ToJSVal Int53 where + toJSVal = return . pToJSVal + {-# INLINE toJSVal #-} + +instance ToJSVal Word53 where + toJSVal = return . pToJSVal + {-# INLINE toJSVal #-} + +-- | 'Nothing' unless the value is a Number holding an integer in range. +instance FromJSVal Int53 where + fromJSVal v = (>>= fromDouble toInt53) <$> fromJSVal v + fromJSValUnchecked v = fromJSVal v >>= maybe (fail "fromJSValUnchecked: not an Int53") return + +-- | 'Nothing' unless the value is a Number holding an integer in range. +instance FromJSVal Word53 where + fromJSVal v = (>>= fromDouble toWord53) <$> fromJSVal v + fromJSValUnchecked v = fromJSVal v >>= maybe (fail "fromJSValUnchecked: not a Word53") return diff --git a/GHCJS/Marshal/Internal.hs b/GHCJS/Marshal/Internal.hs --- a/GHCJS/Marshal/Internal.hs +++ b/GHCJS/Marshal/Internal.hs @@ -258,3 +258,54 @@ packJSS :: String -> JSString packJSS = JSS.JSString . Prim.toJSString + +-- ----------------------------------------------------------------------------- +-- Instances for ghcjs-base's own JSVal newtypes. They live here, with the +-- classes, so they are not orphans and need no extra imports. jsaddle +-- provides the same instances for native GHC. + +instance PToJSVal Object where + pToJSVal (OI.Object v) = v + {-# INLINE pToJSVal #-} + +-- | Unchecked: wraps any value. +instance PFromJSVal Object where + pFromJSVal = OI.Object + {-# INLINE pFromJSVal #-} + +instance ToJSVal Object where + toJSVal (OI.Object v) = return v + {-# INLINE toJSVal #-} + +-- | 'Nothing' for @null@ and @undefined@ (as for the ghcjs-dom types); +-- 'fromJSValUnchecked' wraps any value. +instance FromJSVal Object where + fromJSVal v + | F.isNull v || F.isUndefined v = return Nothing + | otherwise = return (Just (OI.Object v)) + {-# INLINE fromJSVal #-} + fromJSValUnchecked = return . OI.Object + {-# INLINE fromJSValUnchecked #-} + +instance PToJSVal (AI.SomeJSArray m) where + pToJSVal (AI.SomeJSArray v) = v + {-# INLINE pToJSVal #-} + +-- | Unchecked: wraps any value. +instance PFromJSVal (AI.SomeJSArray m) where + pFromJSVal = AI.SomeJSArray + {-# INLINE pFromJSVal #-} + +instance ToJSVal (AI.SomeJSArray m) where + toJSVal (AI.SomeJSArray v) = return v + {-# INLINE toJSVal #-} + +-- | 'Nothing' for @null@ and @undefined@; 'fromJSValUnchecked' wraps any +-- value (no @Array.isArray@ check, like the other JSVal newtypes). +instance FromJSVal (AI.SomeJSArray m) where + fromJSVal v + | F.isNull v || F.isUndefined v = return Nothing + | otherwise = return (Just (AI.SomeJSArray v)) + {-# INLINE fromJSVal #-} + fromJSValUnchecked = return . AI.SomeJSArray + {-# INLINE fromJSValUnchecked #-} diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -1,10 +1,15 @@ cabal-version: 3.0 name: ghcjs-base -version: 0.8.0.4 +version: 0.8.1.0 synopsis: base library for GHCJS +description: + JavaScript types, marshalling (GHCJS.Marshal), foreign helpers and + JavaScript.* data structure bindings for the GHC JavaScript backend + (and legacy GHCJS). homepage: http://github.com/ghcjs/ghcjs-base license: MIT license-file: LICENSE +extra-doc-files: ChangeLog.md author: Luite Stegeman maintainer: stegeman@gmail.com category: Web @@ -70,6 +75,7 @@ GHCJS.Foreign GHCJS.Foreign.Export GHCJS.Foreign.Internal + GHCJS.Int53 GHCJS.Marshal GHCJS.Marshal.Internal GHCJS.Marshal.Pure @@ -134,7 +140,7 @@ scientific >= 0.3.7 && < 0.4, vector >= 0.10 && < 0.14, containers >= 0.5 && < 0.9, - time >= 1.5 && < 1.15, + time >= 1.5 && < 1.16, hashable >= 1.2 && < 1.6, unordered-containers >= 0.2 && < 0.3, attoparsec >= 0.11 && < 0.15,