packages feed

haste-compiler 0.5.4.1 → 0.5.4.2

raw patch · 8 files changed

+70/−25 lines, 8 files

Files

haste-compiler.cabal view
@@ -1,5 +1,5 @@ Name:           haste-compiler-Version:        0.5.4.1+Version:        0.5.4.2 License:        BSD3 License-File:   LICENSE Synopsis:       Haskell To ECMAScript compiler
lib/rts.js view
@@ -1,5 +1,6 @@ // This object will hold all exports. var Haste = {};+if(typeof window === 'undefined') window = global;  /* Constructor functions for small ADTs. */ function T0(t){this._=t;}@@ -349,10 +350,35 @@     return 2; } +/* Convert a JS exception into a Haskell JSException */+function __hsException(e) {+  e = e.toString();+  var x = new Long(2904464383, 3929545892, true);+  var y = new Long(3027541338, 3270546716, true);+  var t = new T5(0, x, y+                  , new T5(0, x, y+                            , unCStr("haste-prim")+                            , unCStr("Haste.Prim.Foreign")+                            , unCStr("JSException")), __Z, __Z);+  var show = function(x) {return unCStr(E(x).a);}+  var dispEx = function(x) {return unCStr("JavaScript exception: " + E(x).a);}+  var showList = function(_, s) {return unAppCStr(e, s);}+  var showsPrec = function(_, _p, s) {return unAppCStr(e, s);}+  var showDict = new T3(0, showsPrec, show, showList);+  var self;+  var fromEx = function(_) {return new T1(1, self);}+  var dict = new T5(0, t, showDict, null /* toException */, fromEx, dispEx);+  self = new T2(0, dict, new T1(0, e));+  return self;+}+ function jsCatch(act, handler) {     try {         return B(A(act,[0]));     } catch(e) {+        if(typeof e._ === 'undefined') {+            e = __hsException(e);+        }         return B(A(handler,[e, 0]));     } }
libraries/haste-lib/src/Haste/Foreign.hs view
@@ -5,7 +5,7 @@     ToAny (..), FromAny (..), JSAny,     Opaque, toOpaque, fromOpaque,     nullValue, toObject, has, get, index,-    getMaybe, hasAll, lookupAny,+    getMaybe, hasAll, lookupAny, JSException (..),      -- * Importing and exporting JavaScript functions     FFI, JSFunc,
libraries/haste-lib/src/Haste/Graphics/Canvas.hs view
@@ -280,8 +280,8 @@     _    -> return Nothing  -- | Create an off-screen buffer of the specified size.-createCanvas :: Int -> Int -> IO Canvas-createCanvas w h = do+createCanvas :: MonadIO m => Int -> Int -> m Canvas+createCanvas w h = liftIO $ do   buf <- newElem "canvas"   setProp buf "width" (toJSString w)   setProp buf "height" (toJSString h)
libraries/haste-prim/src/Haste/Prim/Any.hs view
@@ -246,9 +246,9 @@ -- differs in semantics if the value in question is a) not a number, and -- b) passed verbatim back into JS land instance FromAny Float where-  fromAny x = unsafeCoerce x+  fromAny x = return (unsafeCoerce x) instance FromAny Double where-  fromAny x = unsafeCoerce x+  fromAny x = return (unsafeCoerce x)  instance FromAny Char where   fromAny x = return (unsafeCoerce (jsNumber x))
libraries/haste-prim/src/Haste/Prim/Foreign.hs view
@@ -1,13 +1,14 @@ {-# LANGUAGE ForeignFunctionInterface, OverloadedStrings, BangPatterns, CPP #-} {-# LANGUAGE TypeFamilies, FlexibleInstances, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ < 710 {-# LANGUAGE OverlappingInstances #-} #endif -- | High level JavaScript foreign interface. module Haste.Prim.Foreign (     module Haste.Prim.Any,-    FFI, JSFunc,+    FFI, JSFunc, JSException (..),     ffi, constant, export #if __GLASGOW_HASKELL__ >= 710     , safe_ffi, StaticPtr@@ -18,11 +19,15 @@ #if __GLASGOW_HASKELL__ >= 710 import GHC.StaticPtr (StaticPtr, deRefStaticPtr) #endif+import Unsafe.Coerce+import Control.Exception+import Data.Typeable  -- | A JS function. type JSFun = JSAny  #ifdef __HASTE__+foreign import ccall __strict :: JSAny -> JSAny foreign import ccall "eval" __eval :: JSString -> JSFun foreign import ccall __apply :: JSFun -> Ptr [JSAny] -> IO JSAny foreign import ccall __app0  :: JSFun -> IO JSAny@@ -36,6 +41,8 @@                              -> IO JSAny foreign import ccall __createJSFunc :: Int -> JSAny -> IO JSAny #else+__strict :: JSAny -> JSAny+__strict x = x __eval :: JSString -> JSFun __eval _ = undefined __apply :: JSFun -> Ptr [JSAny] -> IO JSAny@@ -152,20 +159,29 @@   mkJSFunc = toAny   arity _  = 0 +{-# INLINE strictly #-}+strictly :: a -> a+strictly x = unsafeCoerce (__strict (unsafeCoerce x))++{-# RULES+  "strictly" forall x. __strict x+    = unsafeCoerce x+  #-}+ instance ToAny a => JSFunc (IO a) where   mkJSFunc = fmap toAny   arity _  = 1  instance (FromAny a, JSFunc b) => JSFunc (a -> b) where-  mkJSFunc f = mkJSFunc . f . veryUnsafePerformIO . fromAny+  mkJSFunc f = mkJSFunc . f . strictly . veryUnsafePerformIO . fromAny   arity f    = 1 + arity (f undefined)  instance (FromAny a, JSFunc b) => ToAny (a -> b) where   toAny f =-    veryUnsafePerformIO . __createJSFunc (arity f) . toAny . toOpaque $ mkJSFunc f+    strictly . veryUnsafePerformIO . __createJSFunc (arity f) . toAny . toOpaque $ mkJSFunc f  instance ToAny a => ToAny (IO a) where-  toAny = veryUnsafePerformIO . __createJSFunc 0 . toAny . toOpaque . mkJSFunc+  toAny = strictly . veryUnsafePerformIO . __createJSFunc 0 . toAny . toOpaque . mkJSFunc  #if __GLASGOW_HASKELL__ < 710 instance FFI a => FromAny a where@@ -173,3 +189,12 @@ instance {-# OVERLAPPABLE #-} FFI a => FromAny a where #endif   fromAny f = return $ __ffi f []++-- | An exception raised from foreign JavaScript code.+data JSException = JSException JSString+  deriving (Show, Typeable)++instance Exception JSException where+#if __GLASGOW_HASKELL__ >= 710+  displayException (JSException e) = "JavaScript exception: " ++ fromJSStr e+#endif
libraries/haste-prim/src/Haste/Prim/JSType.hs view
@@ -38,7 +38,6 @@ foreign import ccall "Number" jsNumber          :: JSString -> Double foreign import ccall "String" jsString          :: Double -> JSString foreign import ccall jsTrunc                    :: Double -> Int-foreign import ccall jsTruncW                   :: Double -> Int foreign import ccall "I_toInt" jsIToInt         :: ByteArray# -> Int foreign import ccall "I_toString" jsIToString   :: ByteArray# -> JSString foreign import ccall "I_fromString" jsStringToI :: JSString -> ByteArray#@@ -47,17 +46,12 @@ unsafeToJSString :: a -> JSString unsafeToJSString = unsafeCoerce# jsString -unsafeIntFromJSString :: JSString -> Maybe a+unsafeIntFromJSString :: JSString -> Maybe Int unsafeIntFromJSString s =     case jsNumber s of       d | isNaN d   -> Nothing         | otherwise -> Just (unsafeCoerce# (jsTrunc d)) -unsafeWordFromJSString :: JSString -> Maybe a-unsafeWordFromJSString s =-    case jsNumber s of-      d | isNaN d   -> Nothing-        | otherwise -> Just (unsafeCoerce# (jsTruncW d))  -- JSNum instances @@ -124,25 +118,25 @@   fromJSString = unsafeIntFromJSString instance JSType Int8 where   toJSString = unsafeToJSString-  fromJSString = unsafeIntFromJSString+  fromJSString = fmap fromIntegral . unsafeIntFromJSString instance JSType Int16 where   toJSString = unsafeToJSString-  fromJSString = unsafeIntFromJSString+  fromJSString = fmap fromIntegral . unsafeIntFromJSString instance JSType Int32 where   toJSString = unsafeToJSString-  fromJSString = unsafeIntFromJSString+  fromJSString = unsafeCoerce# unsafeIntFromJSString instance JSType Word where   toJSString = unsafeToJSString-  fromJSString = unsafeWordFromJSString+  fromJSString = fmap fromIntegral . unsafeIntFromJSString instance JSType Word8 where   toJSString = unsafeToJSString-  fromJSString = unsafeWordFromJSString+  fromJSString = fmap fromIntegral . unsafeIntFromJSString instance JSType Word16 where   toJSString = unsafeToJSString-  fromJSString = unsafeWordFromJSString+  fromJSString = fmap fromIntegral . unsafeIntFromJSString instance JSType Word32 where   toJSString = unsafeToJSString-  fromJSString = unsafeWordFromJSString+  fromJSString = fmap fromIntegral . unsafeIntFromJSString  instance JSType Float where   fromJSString s =
src/Haste/Version.hs view
@@ -12,7 +12,7 @@  -- | Current Haste version. hasteVersion :: Version-hasteVersion = Version [0,5,4,1] []+hasteVersion = Version [0,5,4,2] []  -- | Current Haste version as an Int. The format of this version number is --   MAJOR*10 000 + MINOR*100 + MICRO.