diff --git a/haste-compiler.cabal b/haste-compiler.cabal --- a/haste-compiler.cabal +++ b/haste-compiler.cabal @@ -1,5 +1,5 @@ Name: haste-compiler -Version: 0.5.3 +Version: 0.5.4 License: BSD3 License-File: LICENSE Synopsis: Haskell To ECMAScript compiler diff --git a/lib/array.js b/lib/array.js --- a/lib/array.js +++ b/lib/array.js @@ -16,22 +16,23 @@ if(padding < 8) { n += padding; } - var arr = {}; var buffer = new ArrayBuffer(n); - var views = {}; - views['i8'] = new Int8Array(buffer); - views['i16'] = new Int16Array(buffer); - views['i32'] = new Int32Array(buffer); - views['w8'] = new Uint8Array(buffer); - views['w16'] = new Uint16Array(buffer); - views['w32'] = new Uint32Array(buffer); - views['f32'] = new Float32Array(buffer); - views['f64'] = new Float64Array(buffer); - arr['b'] = buffer; - arr['v'] = views; - // ByteArray and Addr are the same thing, so keep an offset if we get - // casted. - arr['off'] = 0; + var views = + { 'i8' : new Int8Array(buffer) + , 'i16': new Int16Array(buffer) + , 'i32': new Int32Array(buffer) + , 'w8' : new Uint8Array(buffer) + , 'w16': new Uint16Array(buffer) + , 'w32': new Uint32Array(buffer) + , 'f32': new Float32Array(buffer) + , 'f64': new Float64Array(buffer) + }; + var arr = + { 'b' : buffer + , 'v' : views + , 'off': 0 + }; return arr; } +window['newArr'] = newArr; window['newByteArr'] = newByteArr; diff --git a/libraries/haste-lib/src/Haste/DOM/JSString.hs b/libraries/haste-lib/src/Haste/DOM/JSString.hs --- a/libraries/haste-lib/src/Haste/DOM/JSString.hs +++ b/libraries/haste-lib/src/Haste/DOM/JSString.hs @@ -33,14 +33,16 @@ type AttrValue = JSString jsGet :: Elem -> JSString -> IO JSString -jsGet = ffi "(function(e,p){return e[p].toString();})" +jsGet = ffi "(function(e,p){var x = e[p];\ + \return typeof x === 'undefined' ? '' : x.toString();})" jsGetAttr :: Elem -> JSString -> IO JSString jsGetAttr = ffi "(function(e,p){\ \return e.hasAttribute(p) ? e.getAttribute(p) : '';})" jsGetStyle :: Elem -> JSString -> IO JSString -jsGetStyle = ffi "(function(e,p){return e.style[p].toString();})" +jsGetStyle = ffi "(function(e,p){var x = e.style[p];\ + \return typeof x === 'undefined' ? '' : x.toString();})" jsFind :: JSString -> IO (Maybe Elem) jsFind = ffi "(function(id){return document.getElementById(id);})" diff --git a/libraries/haste-lib/src/Haste/Foreign.hs b/libraries/haste-lib/src/Haste/Foreign.hs --- a/libraries/haste-lib/src/Haste/Foreign.hs +++ b/libraries/haste-lib/src/Haste/Foreign.hs @@ -1,10 +1,11 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, OverloadedStrings #-} -- | High level JavaScript foreign interface. module Haste.Foreign ( -- * Conversion to/from JSAny ToAny (..), FromAny (..), JSAny, Opaque, toOpaque, fromOpaque, nullValue, toObject, has, get, index, + getMaybe, hasAll, lookupAny, -- * Importing and exporting JavaScript functions FFI, JSFunc, @@ -14,3 +15,40 @@ #endif ) where import Haste.Prim.Foreign +import Haste.Prim (JSString) +import qualified Haste.JSString as J +import Control.Monad (foldM) +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative ((<$>), pure) +#endif + +-- | Read a member from a JS object. Succeeds if the member exists. +getMaybe :: (FromAny a) => JSAny -> JSString -> IO (Maybe a) +getMaybe a k = do exists <- has a k + if exists then Just <$> get a k + else pure Nothing + +-- | Checks if a JS object has a list of members. Succeeds if the JS object +-- has every member given in the list. +hasAll :: JSAny -> [JSString] -> IO Bool +hasAll a ks = and <$> mapM (has a) ks + + +-- | Looks up an object by a `.`-separated string. Succeeds if the lowest +-- member exists. +-- +-- Usage example: +-- +-- >>> {'child': {'childrer': {'childerest': "I am very much a child."}}} +-- +-- Given the JS Object above, we can access the deeply nested object, +-- childerest, by lookupAny as in the below example +-- +-- >>> lookupAny jsObject "child.childrer.childerest" +lookupAny :: JSAny -> JSString -> IO (Maybe JSAny) +lookupAny root i = foldM hasGet (Just root) $ J.match dotsplit i + where hasGet Nothing _ = pure Nothing + hasGet (Just parent) ident = do h <- has parent ident + if h then Just <$> get parent ident + else pure Nothing + dotsplit = J.regex "[^.]+" "g" diff --git a/libraries/haste-lib/src/Haste/JSString.hs b/libraries/haste-lib/src/Haste/JSString.hs --- a/libraries/haste-lib/src/Haste/JSString.hs +++ b/libraries/haste-lib/src/Haste/JSString.hs @@ -29,7 +29,7 @@ last, replicate) import Data.String import Haste.Prim -import Haste.Foreign +import Haste.Prim.Foreign #ifdef __HASTE__ import GHC.Prim diff --git a/libraries/haste-lib/src/Haste/Serialize.hs b/libraries/haste-lib/src/Haste/Serialize.hs --- a/libraries/haste-lib/src/Haste/Serialize.hs +++ b/libraries/haste-lib/src/Haste/Serialize.hs @@ -165,7 +165,7 @@ Dict o .: key = case lookup key o of Just x -> parseJSON x - _ -> Parser $ Left "Key not found" + _ -> Parser . Left $ "Key not found: " ++ fromJSStr key _ .: _ = Parser $ Left "Tried to do lookup on non-object!" diff --git a/src/Haste/Version.hs b/src/Haste/Version.hs --- a/src/Haste/Version.hs +++ b/src/Haste/Version.hs @@ -12,7 +12,7 @@ -- | Current Haste version. hasteVersion :: Version -hasteVersion = Version [0,5,3] [] +hasteVersion = Version [0,5,4] [] -- | Current Haste version as an Int. The format of this version number is -- MAJOR*10 000 + MINOR*100 + MICRO. diff --git a/src/haste-boot.hs b/src/haste-boot.hs --- a/src/haste-boot.hs +++ b/src/haste-boot.hs @@ -29,6 +29,8 @@ primVersion = "0.3.0.0" #endif +data HasteCabal = Download | Prebuilt FilePath | Source (Maybe FilePath) + data Cfg = Cfg { getLibs :: Bool, getClosure :: Bool, @@ -36,7 +38,7 @@ tracePrimops :: Bool, forceBoot :: Bool, initialPortableBoot :: Bool, - getHasteCabal :: Bool, + getHasteCabal :: HasteCabal, verbose :: Bool } @@ -49,7 +51,7 @@ tracePrimops = False, forceBoot = False, initialPortableBoot = False, - getHasteCabal = True, + getHasteCabal = Download, verbose = False } #else @@ -60,7 +62,7 @@ tracePrimops = False, forceBoot = False, initialPortableBoot = False, - getHasteCabal = True, + getHasteCabal = Download, verbose = False } #endif @@ -70,7 +72,7 @@ useLocalLibs = True, forceBoot = True, getClosure = False, - getHasteCabal = False + getHasteCabal = Source Nothing } setInitialPortableBoot :: Cfg -> Cfg @@ -80,7 +82,7 @@ forceBoot = True, getClosure = True, initialPortableBoot = True, - getHasteCabal = True + getHasteCabal = Download } specs :: [OptDescr (Cfg -> Cfg)] @@ -89,7 +91,7 @@ Option "" ["dev"] (NoArg devBoot) $ "Boot Haste for development. Implies --force " ++ - "--local --no-closure --no-haste-cabal" + "--local --no-closure --build-haste-cabal" , Option "" ["force"] #else Option "" ["force"] @@ -115,10 +117,17 @@ "Don't download Closure compiler. You won't be able " ++ "to use --opt-minify, unless you manually " ++ "give hastec the path to compiler.jar." - , Option "" ["no-haste-cabal"] - (NoArg $ \cfg -> cfg {getHasteCabal = False}) $ - "Don't install haste-cabal. This is probably not " ++ - "what you want." + , Option "" ["download-haste-cabal"] + (NoArg $ \cfg -> cfg {getHasteCabal = Download}) $ + "Download pre-built haste-cabal for your platform. " ++ + "This is the default behaviour." + , Option "" ["with-haste-cabal"] + (ReqArg (\f cfg -> cfg {getHasteCabal = Prebuilt f}) "FILE") $ + "Use FILE to provide haste-cabal." + , Option "" ["build-haste-cabal"] + (OptArg (\md cfg -> cfg {getHasteCabal = Source md}) "DIR") $ + "Build haste-cabal from the source contained in DIR. " ++ + "If DIR is not specified, `../cabal/' is assumed." , Option "" ["no-libs"] (NoArg $ \cfg -> cfg {getLibs = False}) $ "Don't install any libraries. This is probably not " ++ @@ -168,11 +177,15 @@ mapM_ clearDir [pkgUserLibDir, jsmodUserDir, pkgUserDir, pkgSysLibDir, jsmodSysDir, pkgSysDir] - when (getHasteCabal cfg) $ do - installHasteCabal portableHaste tmpdir + mkdir True (hasteCabalRootDir portableHaste) + case getHasteCabal cfg of + Download -> installHasteCabal portableHaste tmpdir + Prebuilt fp -> copyHasteCabal portableHaste fp + Source mdir -> buildHasteCabal portableHaste (maybe "../cabal" id mdir) -- Spawn off closure download in the background. - closure <- future $ when (getClosure cfg) installClosure + dir <- pwd -- use absolute path for closure to avoid dir changing race + closure <- future $ when (getClosure cfg) (installClosure dir) when (not $ useLocalLibs cfg) $ do fetchLibs tmpdir @@ -199,48 +212,55 @@ exists <- isDirectory dir when exists $ rmdir dir +copyHasteCabal :: Bool -> FilePath -> Shell () +copyHasteCabal portable file = + cp file (hasteCabalRootDir portable "haste-cabal") + +buildHasteCabal :: Bool -> FilePath -> Shell () +buildHasteCabal portable dir = do + inDirectory dir $ run_ "runghc" ["build-haste-cabal.hs"] "" + copyHasteCabal portable (dir "haste-cabal" "haste-cabal.bin") + installHasteCabal :: Bool -> FilePath -> Shell () installHasteCabal portable tmpdir = do echo "Downloading haste-cabal from GitHub" f <- (decompress . BSL.fromChunks . (:[])) `fmap` fetchBytes hasteCabalUrl if os == "linux" then do - mkdir True hasteCabalRootDir - liftIO . unpack hasteCabalRootDir $ read f + liftIO . unpack rootdir $ read f liftIO $ copyPermissions hasteBinary - (hasteCabalRootDir "haste-cabal/haste-cabal.bin") - output (hasteBinDir hasteCabalFile) launcher + (rootdir "haste-cabal/haste-cabal.bin") + output (hasteBinDir hasteCabalFile) (hasteCabalLauncher portable) else do liftIO $ BSL.writeFile (hasteBinDir hasteCabalFile) f liftIO $ copyPermissions hasteBinary (hasteBinDir hasteCabalFile) where + rootdir = hasteCabalRootDir portable baseUrl = "http://valderman.github.io/haste-libs/" hasteCabalUrl | os == "linux" = baseUrl ++ "haste-cabal.linux.tar.bz2" | otherwise = baseUrl ++ "haste-cabal" <.> os <.> "bz2" hasteCabalFile = "haste-cabal" ++ if os == "mingw32" then ".exe" else "" - hasteCabalRootDir - | portable = hasteBinDir ".." - | otherwise = hasteSysDir +hasteCabalRootDir :: Bool -> FilePath +hasteCabalRootDir True = hasteBinDir ".." +hasteCabalRootDir False = hasteSysDir - -- We need to determine the haste-cabal libdir at runtime if we're - -- portable - launcher - | portable = unlines [ - "#!/bin/bash", - "HASTEC=\"$(dirname $0)/hastec\"", - "DIR=\"$($HASTEC --print-libdir)/../haste-cabal\"", - "export LD_LIBRARY_PATH=$DIR", - "exec $DIR/haste-cabal.bin $@" - ] - | otherwise = unlines [ - "#!/bin/bash", - "DIR=\"" ++ hasteCabalRootDir "haste-cabal" ++ "\"", - "export LD_LIBRARY_PATH=$DIR", - "exec $DIR/haste-cabal.bin $@" - ] +-- We need to determine the haste-cabal libdir at runtime if we're +-- portable +hasteCabalLauncher :: Bool -> String +hasteCabalLauncher True = unlines + [ "#!/bin/bash" + , "HASTEC=\"$(dirname $0)/hastec\"" + , "DIR=\"$($HASTEC --print-libdir)/../haste-cabal\"" + , "export LD_LIBRARY_PATH=$DIR" + , "exec $DIR/haste-cabal.bin $@" ] +hasteCabalLauncher False = unlines + [ "#!/bin/bash" + , "DIR=\"" ++ hasteCabalRootDir False "haste-cabal" ++ "\"" + , "export LD_LIBRARY_PATH=$DIR" + , "exec $DIR/haste-cabal.bin $@" ] -- | Fetch the Haste base libs. fetchLibs :: FilePath -> Shell () @@ -253,14 +273,14 @@ "http://valderman.github.io/haste-libs/haste-libs-" ++ showVersion v ++ ".tar.bz2" -- | Fetch and install the Closure compiler. -installClosure :: Shell () -installClosure = do +installClosure :: FilePath -> Shell () +installClosure dir = do echo "Downloading Google Closure compiler..." downloadClosure `orElse` do echo "Couldn't install Closure compiler; continuing without." where downloadClosure = do - fetchBytes closureURI >>= (liftIO . BS.writeFile closureCompiler) + fetchBytes closureURI >>= (liftIO . BS.writeFile (dir closureCompiler)) closureURI = "http://valderman.github.io/haste-libs/compiler.jar"