haste-compiler 0.5.1.2 → 0.5.1.3

raw patch · 17 files changed

+123/−228 lines, 17 filesdep ~ghc-simpledep ~shellmatePVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: ghc-simple, shellmate

API changes (from Hackage documentation)

Files

• haste-compiler.cabal +3/−36
• lib/array.js +1/−0
• libraries/haste-lib/src/Haste/DOM.hs +12/−7
• libraries/haste-lib/src/Haste/DOM/Core.hs +12/−8
• libraries/haste-lib/src/Haste/DOM/JSString.hs +13/−7
• libraries/haste-lib/src/Haste/Events.hs +13/−4
• libraries/haste-lib/src/Haste/Random.hs +17/−4
• libraries/haste-prim/src/Haste/Prim/Any.hs +8/−2
• libraries/haste-prim/src/Haste/Prim/Foreign.hs +5/−4
• src/Haste/Args.hs +9/−18
• src/Haste/Environment.hs +1/−10
• src/Haste/Opts.hs +4/−3
• src/Haste/Version.hs +1/−1
• src/haste-boot.hs +11/−5
• src/haste-copy-pkg.hs +0/−63
• src/haste-install-his.hs +0/−44
• src/hastec.hs +13/−12

@@ -1,5 +1,5 @@ Name:           haste-compiler-Version:        0.5.1.2+Version:        0.5.1.3 License:        BSD3 License-File:   LICENSE Synopsis:       Haskell To ECMAScript compiler@@ -10,8 +10,8 @@                 OSX.                  Non-Linux users are strongly recommended to download pre-built-                binary packages from http://haste-lang.org/downloads instead-                of building from source.+                binary packages from haste-lang.org instead of building+                from source. Category:       JavaScript, Compiler, Web Cabal-Version:  >= 1.10 Build-Type:     Custom@@ -203,39 +203,6 @@                        terminfo     if os(windows)         c-sources: utils/haste-pkg/CRT_noglob.c--Executable haste-install-his-    if flag(only-library)-        buildable: False-    Main-Is: haste-install-his.hs-    Hs-Source-Dirs: src-    if flag(portable)-        CPP-Options: -DPORTABLE-    Build-Depends:-        base < 5,-        shellmate,-        ghc-paths,-        ghc,-        directory-    default-language: Haskell98--Executable haste-copy-pkg-    if flag(only-library)-        buildable: False-    Main-Is: haste-copy-pkg.hs-    Other-Modules:-        Haste.Environment-        Haste.GHCPaths-    Hs-Source-Dirs: src-    if flag(portable)-        CPP-Options: -DPORTABLE-    Build-Depends:-        base < 5,-        shellmate >= 0.1.5,-        ghc-paths,-        ghc,-        directory-    default-language: Haskell98  Executable haste-cat     if flag(only-library)

@@ -34,3 +34,4 @@     arr['off'] = 0;     return arr; }+window['newByteArr'] = newByteArr;

@@ -9,7 +9,7 @@     setChildren, clearChildren, deleteChild, removeChild,     -- Own exports     PropID, ElemID, QuerySelector, ElemClass, AttrValue,-    style, attr, (=:),+    prop, style, attr, (=:),     newElem, newTextElem,     elemById, elemsByQS, elemsByClass,     setProp, getProp, setAttr, getAttr, J.getValue,@@ -37,6 +37,11 @@ attr :: String -> AttrName attr = AttrName . toJSStr +-- | Create a DOM property name.+--   See <http://stackoverflow.com/questions/6003819/properties-and-attributes-in-html> for more information about the difference between attributes and properties.+prop :: String -> AttrName+prop = PropName . toJSStr+ -- | Create an 'Attribute'. (=:) :: AttrName -> AttrValue -> Attribute name =: val = attribute name (toJSStr val)@@ -51,27 +56,27 @@  -- | Set a property of the given element. setProp :: (IsElem e, MonadIO m) => e -> PropID -> String -> m ()-setProp e prop val = J.setProp e (toJSStr prop) (toJSStr val)+setProp e property val = J.setProp e (toJSStr property) (toJSStr val)  -- | Set an attribute of the given element. setAttr :: (IsElem e, MonadIO m) => e -> PropID -> String -> m ()-setAttr e prop val = J.setAttr e (toJSStr prop) (toJSStr val)+setAttr e property val = J.setAttr e (toJSStr property) (toJSStr val)  -- | Get a property of an element. getProp :: (IsElem e, MonadIO m) => e -> PropID -> m String-getProp e prop = J.getProp e (toJSStr prop) >>= return . fromJSStr+getProp e property = J.getProp e (toJSStr property) >>= return . fromJSStr  -- | Get an attribute of an element. getAttr :: (IsElem e, MonadIO m) => e -> PropID -> m String-getAttr e prop = J.getAttr e (toJSStr prop) >>= return . fromJSStr+getAttr e property = J.getAttr e (toJSStr property) >>= return . fromJSStr  -- | Get a CSS style property of an element. getStyle :: (IsElem e, MonadIO m) => e -> PropID -> m String-getStyle e prop = J.getStyle e (toJSStr prop) >>= return . fromJSStr+getStyle e property = J.getStyle e (toJSStr property) >>= return . fromJSStr  -- | Set a CSS style property on an element. setStyle :: (IsElem e, MonadIO m) => e -> PropID -> String -> m ()-setStyle e prop val = J.setStyle e (toJSStr prop) (toJSStr val)+setStyle e property val = J.setStyle e (toJSStr property) (toJSStr val)  -- | Get an element by its HTML ID attribute. elemById :: MonadIO m => ElemID -> m (Maybe Elem)

@@ -114,10 +114,10 @@ -- | Set a number of 'Attribute's on the element produced by an IO action. --   Gives more convenient syntax when creating elements: -----     newElem "div" `with` [---         style "border" =: "1px solid black",---         ...---       ]+--   > newElem "div" `with` [+--   >     style "border" =: "1px solid black",+--   >     ...+--   >   ] -- with :: (IsElem e, MonadIO m) => m e -> [Attribute] -> m e with m attrs = do@@ -161,8 +161,9 @@ appendChild :: (IsElem parent, IsElem child, MonadIO m) => parent -> child -> m () appendChild parent child = liftIO $ jsAppendChild (elemOf child) (elemOf parent) -{-# DEPRECATED addChild "Use appendChild instead" #-}+{-# DEPRECATED addChild "Use appendChild instead. Note that appendChild == flip addChild." #-} -- | DEPRECATED: use 'appendChild' instead!+--   Note that @appendChild == flip addChild@. addChild :: (IsElem parent, IsElem child, MonadIO m) => child -> parent -> m () addChild = flip appendChild @@ -176,8 +177,10 @@ insertChildBefore parent oldChild child =   liftIO $ jsAddChildBefore (elemOf child) (elemOf parent) (elemOf oldChild) -{-# DEPRECATED addChildBefore "Use insertChildBefore instead" #-}+{-# DEPRECATED addChildBefore "Use insertChildBefore instead. Note insertChildBefore == \\parent new old -> addChildBefore new parent old." #-} -- | DEPRECATED: use 'insertChildBefore' instead!+--   Note that+--   @insertChildBefore == \parent new old -> addChildBefore new parent old@. addChildBefore :: (IsElem parent, IsElem child, MonadIO m)                => child -> parent -> child -> m () addChildBefore child parent oldChild = insertChildBefore parent oldChild child@@ -217,10 +220,11 @@             -> m () deleteChild parent child = liftIO $ jsKillChild (elemOf child) (elemOf parent) -{-# DEPRECATED removeChild "Use deleteChild instead" #-}+{-# DEPRECATED removeChild "Use deleteChild instead. Note that deleteChild = flip removeChild." #-} -- | DEPRECATED: use 'deleteChild' instead!+--   Note that @deleteChild = flip removeChild@. removeChild :: (IsElem parent, IsElem child, MonadIO m)             => child             -> parent             -> m ()-removeChild child parent = liftIO $ jsKillChild (elemOf child) (elemOf parent)+removeChild = flip deleteChild

@@ -9,7 +9,7 @@     setChildren, clearChildren, deleteChild, removeChild,     -- Own exports     PropID, ElemID, QuerySelector, ElemClass, AttrValue,-    style, attr, (=:),+    prop, style, attr, (=:),     newElem, newTextElem,     elemById, elemsByQS, elemsByClass,     setProp, getProp, setAttr, getAttr, getValue,@@ -77,7 +77,13 @@ attr :: JSString -> AttrName attr = AttrName +-- | Create a DOM property name.+--   See <http://stackoverflow.com/questions/6003819/properties-and-attributes-in-html> for more information about the difference between attributes and properties.+prop :: JSString -> AttrName+prop = PropName+ -- | Create an 'Attribute'.+infixl 4 =: (=:) :: AttrName -> AttrValue -> Attribute (=:) = attribute @@ -91,11 +97,11 @@  -- | Set a property of the given element. setProp :: (IsElem e, MonadIO m) => e -> PropID -> JSString -> m ()-setProp e prop val = liftIO $ jsSet (elemOf e) prop val+setProp e property val = liftIO $ jsSet (elemOf e) property val  -- | Set an attribute of the given element. setAttr :: (IsElem e, MonadIO m) => e -> PropID -> JSString -> m ()-setAttr e prop val = liftIO $ jsSetAttr (elemOf e) prop val+setAttr e property val = liftIO $ jsSetAttr (elemOf e) property val  -- | Get the value property of an element; a handy shortcut. getValue :: (IsElem e, MonadIO m, JSType a) => e -> m (Maybe a)@@ -103,19 +109,19 @@  -- | Get a property of an element. getProp :: (IsElem e, MonadIO m) => e -> PropID -> m JSString-getProp e prop = liftIO $ jsGet (elemOf e) prop+getProp e property = liftIO $ jsGet (elemOf e) property  -- | Get an attribute of an element. getAttr :: (IsElem e, MonadIO m) => e -> PropID -> m JSString-getAttr e prop = liftIO $ jsGetAttr (elemOf e) prop+getAttr e property = liftIO $ jsGetAttr (elemOf e) property  -- | Get a CSS style property of an element. getStyle :: (IsElem e, MonadIO m) => e -> PropID -> m JSString-getStyle e prop = liftIO $ jsGetStyle (elemOf e) prop+getStyle e property = liftIO $ jsGetStyle (elemOf e) property  -- | Set a CSS style property on an element. setStyle :: (IsElem e, MonadIO m) => e -> PropID -> JSString -> m ()-setStyle e prop val = liftIO $ jsSetStyle (elemOf e) prop val+setStyle e property val = liftIO $ jsSetStyle (elemOf e) property val  -- | Get an element by its HTML ID attribute. elemById :: MonadIO m => ElemID -> m (Maybe Elem)

@@ -1,9 +1,18 @@ -- | Event handling for Haste. module Haste.Events (-    module Core,-    module BasicEvents,-    module KeyEvents,-    module MouseEvents+    -- * Core event functionality+    Event (..), MonadEvent (..),+    HandlerInfo,+    unregisterHandler, onEvent, preventDefault,++    -- * Basic events with no arguments+    BasicEvent (..),++    -- * Keyboard-related events+    KeyEvent (..), KeyData (..), mkKeyData,++    -- * Mouse-related events+    MouseEvent (..), MouseData (..), MouseButton (..)   ) where import Haste.Events.Core as Core import Haste.Events.BasicEvents as BasicEvents

@@ -17,16 +17,29 @@ newtype Seed = Seed JSAny deriving (ToAny, FromAny)  nxt :: Seed -> IO Seed-nxt = ffi "(function(s){return window['md51'](s.join(','));})"+nxt = ffi "(function(s){\+var ba = window['newByteArr'](16);\+ba['v']['w32'][0] = s[0];\+ba['v']['w32'][1] = s[1];\+ba['v']['w32'][2] = s[2];\+ba['v']['w32'][3] = s[3];\+return window['md51'](ba,16);})"  getN :: Seed -> IO Int getN = ffi "(function(s){return s[0];})"  toSeed :: Int -> IO Seed-toSeed = ffi "(function(n){return window['md51'](n.toString());})"+toSeed = ffi "(function(n){\+var ba = window['newByteArr'](16);\+ba['v']['w32'][0] = n;\+return window['md51'](ba,16);})"  createSeed :: IO Seed-createSeed = ffi "(function(){return window['md51'](jsRand().toString());})"+createSeed = ffi "(function(){\+var ba = window['newByteArr'](16);\+ba['v']['f64'][0] = Math.random();\+ba['v']['f64'][1] = Math.random();\+return window['md51'](ba,16);})" #else newtype Seed = Seed (Int, SR.StdGen) @@ -47,7 +60,7 @@ mkSeed :: Int -> Seed mkSeed = unsafePerformIO . toSeed --- | Generate a new seed using Javascript's PRNG.+-- | Generate a new seed using JavaScript's PRNG. newSeed :: MonadIO m => m Seed newSeed = liftIO createSeed 

@@ -103,15 +103,21 @@ -- | Any type that can be converted into a JavaScript value. class ToAny a where   -- | Build a JS object from a Haskell value.+  --   --   The default instance creates an object from any type that derives   --   'Generic' according to the following rules:+  --   --   * Records turn into plain JS objects, with record names as field names.+  --   --   * Non-record product types turn into objects containing a @$data@ field   --     which contains all of the constructor's unnamed fields.+  --   --   * Values of enum types turn into strings matching their constructors.+  --   --   * Non-enum types with more than one constructor gain an extra field,   --     @$tag@, which contains the name of the constructor used to create the   --     object.+  --   toAny :: a -> JSAny   default toAny :: (GToAny (Rep a), Generic a) => a -> JSAny   toAny x =@@ -130,6 +136,8 @@   --   is not possible. Examples of reasonable conversions would be truncating   --   floating point numbers to integers, or turning signed integers into   --   unsigned.+  --+  --   The default instance is the inverse of the default 'ToAny' instance.   fromAny :: JSAny -> IO a   default fromAny :: (GToAny (Rep a), GFromAny (Rep a), Generic a)                   => JSAny -> IO a@@ -464,5 +472,3 @@  withSomeException :: IO a -> SomeException -> IO a withSomeException m _ = m--foreign import ccall "jsLog" dbg :: JSAny -> IO ()

@@ -84,8 +84,9 @@ --   save you from poorly typed JS here, but there are no guarantees. -- --   For instance, the following WILL cause crazy behavior due to wrong types:---   @ffi "(function(x) {return x+1;})" :: Int -> Int -> IO Int@ --+--   > ffi "(function(x) {return x+1;})" :: Int -> Int -> IO Int+-- --   In other words, this function is as unsafe as the JS it calls on. You --   have been warned. --@@ -93,7 +94,7 @@ --   in which case evaluation order does not affect the semantics of the --   imported code, or if (b) the imported code is explicitly marked as strict: -----       someFunction = ffi "__strict(someJSFunction)"+--   > someFunction = ffi "__strict(someJSFunction)" -- --   Literals which depends on some third party initialization, the existence --   of a DOM tree or some other condition which is not fulfilled at load time@@ -125,10 +126,10 @@   #-}  -- | Export a symbol. That symbol may then be accessed from JavaScript through---   Haste.name() as a normal function. Remember, however, that if you are+--   @Haste.name()@ as a normal function. Remember, however, that if you are --   using --with-js to include your JS, in conjunction with --   --opt-minify or any option that implies it, you will instead need---   to access your exports through Haste[\'name\'](), or Closure will mangle+--   to access your exports through @Haste[\'name\']()@, or Closure will mangle --   your function names. {-# INLINE export #-} export :: ToAny a => JSString -> a -> IO ()

@@ -1,20 +1,21 @@-module Haste.Args (parseArgs) where+module Haste.Args (parseArgs, printHelp) where import System.Console.GetOpt import Data.List --- | Parse a list of command line arguments into a config and a list of args---   for GHC. Non-options are passed directly to GHC.+-- | Parse a list of command line arguments into a config, a list of args+--   for GHC, and a list of error messages.+--   Non-options are passed directly to GHC. parseArgs :: [OptDescr (a -> a)]           -> String           -> [String]-          -> Either String (a -> a, [String])+          -> Either String (a -> a, [String], [String]) parseArgs opts hdr args   | "--help" `elem` args || "-?" `elem` args =     Left $ printHelp hdr opts   | otherwise =     let (hasteArgs, ghcArgs) = splitOpts opts args-        (cfgs, _, _) = getOpt Permute opts hasteArgs-    in Right (foldl' (flip (.)) id cfgs, ghcArgs)+        (cfgs, _, errs) = getOpt Permute opts hasteArgs+    in Right (foldl' (flip (.)) id cfgs, ghcArgs, errs)  -- | Split opts into Haste options and others. splitOpts :: [OptDescr a] -> [String] -> ([String], [String])@@ -48,18 +49,8 @@      isHasteOpt opt       | "-o" `isPrefixOf` opt = False-      | otherwise             = prefixElem opt optnames--    optnames =-      concatMap names opts--    names (Option short long _ _) =-      map (\c -> ['-',c]) short ++ map ("--" ++) long---- | Does the given list exist as a prefix of some element in the list of---   lists?-prefixElem :: Eq a => [a] -> [[a]] -> Bool-prefixElem x = or . map (\y -> take (length y) x == y)+      | opt == "--make"       = False+      | otherwise             = and $ zipWith (==) "--" opt  printHelp :: String -> [OptDescr a] -> String printHelp hdr = (hdr ++) . ("\n" ++) . unlines . map helpString

@@ -6,8 +6,7 @@     hasteGhcLibDir,     hostWordSize,     ghcPkgBinary, ghcBinary,-    hasteBinDir, hasteBinary, hastePkgBinary, hasteInstHisBinary,-    hasteCabalBinary, hasteCopyPkgBinary,+    hasteBinDir, hasteBinary, hastePkgBinary, hasteCabalBinary,     closureCompiler, bootFile,     portableHaste, hasteNeedsReboot   ) where@@ -131,17 +130,9 @@ hastePkgBinary :: FilePath hastePkgBinary = hasteBinDir </> "haste-pkg" ++ binaryExt --- | Binary for haste-copy-pkg.-hasteCopyPkgBinary :: FilePath-hasteCopyPkgBinary = hasteBinDir </> "haste-copy-pkg" ++ binaryExt- -- | Binary for haste-pkg. hasteCabalBinary :: FilePath hasteCabalBinary = hasteBinDir </> "haste-cabal" ++ binaryExt---- | Binary for haste-install-his.-hasteInstHisBinary :: FilePath-hasteInstHisBinary = hasteBinDir </> "haste-install-his" ++ binaryExt  -- | JAR for Closure compiler. closureCompiler :: FilePath

@@ -21,7 +21,7 @@     Option "" ["debug"]            (NoArg $ \cfg -> cfg {ppOpts = debugPPOpts (ppOpts cfg)}) $            "Output annotated, pretty-printed JavaScript code. Equivalent to " ++-           "--annotate externals --preserve-names --pretty-print.",+           "--annotate-externals --annotate-symbols --pretty-print.",     Option "" ["ddisable-js-opts"]            (NoArg $ \cfg -> cfg {optimize = False}) $            "Don't perform any optimizations on the JavaScript at all. " ++@@ -118,7 +118,8 @@            "minification slightly less effective.",     Option "" ["preserve-names"]            (NoArg $ \cfg -> cfg {ppOpts = withHSNames (ppOpts cfg)}) $-           "Preserve Haskell names in JS code as far as possible.",+           "Preserve Haskell names in JavaScript code as far as possible. " +++           "Highly experimental and may break your code.",     Option "" ["pretty-print"]            (NoArg $ \cfg -> cfg {ppOpts = withPretty (ppOpts cfg)}) $            "Pretty-print JavaScript output.",@@ -227,4 +228,4 @@     cheap = jsDir </> "cheap-unicode.js"  debugPPOpts :: PPOpts -> PPOpts-debugPPOpts = withPretty . withHSNames . withExtAnnotation+debugPPOpts = withPretty . withAnnotations . withExtAnnotation

@@ -12,7 +12,7 @@  -- | Current Haste version. hasteVersion :: Version-hasteVersion = Version [0,5,1,2] []+hasteVersion = Version [0,5,1,3] []  -- | Current Haste version as an Int. The format of this version number is --   MAJOR*10 000 + MINOR*100 + MICRO.

@@ -5,6 +5,7 @@ import Network.URI import qualified Data.ByteString.Lazy as BS import Data.Version+import Data.List (foldl') import Data.Maybe (fromJust) import Codec.Compression.BZip import Codec.Archive.Tar@@ -160,9 +161,13 @@ main :: IO () main = do   args <- getArgs-  case parseArgs specs hdr args of-    Right (mkConfig, _) -> do-      let cfg = mkConfig defCfg+  when ("--help" `elem` args || "-?" `elem` args) $ do+    putStrLn $ printHelp hdr specs+    exitSuccess++  case getOpt Permute specs args of+    (cfgs, [], []) -> do+      let cfg = foldl' (flip (.)) id cfgs defCfg       when (hasteNeedsReboot || forceBoot cfg) $ do         res <- shell $ if useLocalLibs cfg                          then bootHaste cfg "."@@ -170,8 +175,9 @@         case res of           Right _  -> return ()           Left err -> putStrLn err >> exitFailure-    Left halp -> do-      putStrLn halp+    (cfgs, nonopts, errs) -> do+      mapM_ putStr errs+      mapM_ (\x -> putStrLn $ "unrecognized option `" ++ x ++ "'") nonopts  bootHaste :: Cfg -> FilePath -> Shell () bootHaste cfg tmpdir =

@@ -1,63 +0,0 @@-{-# LANGUAGE CPP #-}--- | haste-copy-pkg; copy a package from file or GHC package DB and fix up its---   paths.-module Main where-import Data.List-import Haste.Environment-import System.Environment (getArgs)-import Control.Shell--main :: IO ()-main = do-  args <- getArgs-  let (dbs, pkgs) = partition ("--package-db=" `isPrefixOf`) args-      pkgdbs = dbs-  if null args-    then do-      putStrLn "Usage: haste-copy-pkg [--package-db=foo.conf] <packages>"-    else do-      res <- shell (mapM_ (copyFromDB pkgdbs) pkgs)-      case res of-        Left err -> error err-        _        -> return ()--copyFromDB :: [String] -> String -> Shell ()-copyFromDB pkgdbs package = do-  pkgdesc <- run ghcPkgBinary (["describe", package] ++ pkgdbs) ""-  run_ hastePkgBinary ["update", "-", "--force", "--global"]-                      (fixPaths package pkgdesc)---- | Hack a config to work with Haste.-fixPaths :: String -> String -> String-fixPaths pkgname pkgtext =-  pkgtext'-  where-    pkgtext' = unlines-             . map fixPath-             . filter (not . ("haddock" `isPrefixOf`))-             . filter (not . ("hs-libraries:" `isPrefixOf`))-             . takeWhile (not . isPrefixOf "---")-             $ lines pkgtext-    -    fixPath str-      | isKey "library-dirs:" str =-        "library-dirs: " ++ importDir </> pkgname-      | isKey "import-dirs:" str =-        "import-dirs: " ++ importDir </> pkgname-      | isKey "include-dirs:" str =-        "include-dirs: " ++ includeDir-      | isKey "pkgroot:" str =-        "pkgroot: \"" ++ pkgRoot ++ "\""-      | "-inplace" `isSuffixOf` str =-        reverse $ drop (length "-inplace") $ reverse str-      | otherwise =-        str--    isKey _ "" =-      False-    isKey key str =-      and $ zipWith (==) key str-    -    importDir  = "${pkgroot}"-    includeDir = "${pkgroot}" </> "include"-    pkgRoot    = "${pkgroot}"

@@ -1,44 +0,0 @@-{-# LANGUAGE TupleSections #-}--- | haste-install-his; install all .hi files in a directory.-module Main where-import Haste.Environment-import System.Environment-import Control.Applicative-import Control.Monad-import Data.List-import Data.Char-import Control.Shell--main :: IO ()-main = do-  args <- getArgs-  case args of-    [package, dir] -> shell $ installFromDir (pkgSysLibDir </> package) dir-    _              -> shell $ echo "Usage: haste-install-his pkgname dir"-  return ()--getHiFiles :: FilePath -> Shell [FilePath]-getHiFiles dir =-  filter (".hi" `isSuffixOf`) <$> ls dir--getSubdirs :: FilePath -> Shell [FilePath]-getSubdirs dir = do-  contents <- ls dir-  someDirs <- mapM (\d -> (d,) <$> isDirectory (dir </> d)) contents-  return [path | (path, isDir) <- someDirs-               , isDir-               , head path /= '.'-               , isUpper (head path)]--installFromDir :: FilePath -> FilePath -> Shell ()-installFromDir base path = do-  hiFiles <- getHiFiles path-  when (not $ null hiFiles) $ do-    mkdir True (pkgSysLibDir </> base)-  mapM_ (installHiFile base path) hiFiles-  getSubdirs path >>= mapM_ (\d -> installFromDir (base </> d) (path </> d))--installHiFile :: FilePath -> FilePath -> FilePath -> Shell ()-installHiFile to from file = do-  echo $ "Installing " ++ from </> file ++ "..."-  cp (from </> file) (to </> file)

@@ -197,7 +197,7 @@     _ <- Sh.shell $ Sh.run_ ghcBinary (pkgargs booting ++ ghcArgs) ""     return ()   where-    Right (_, ghcArgs) = parseArgs hasteOpts "" args+    Right (_, ghcArgs, _) = parseArgs hasteOpts "" args     pkgargs booting =       ["-no-global-package-db",        "-no-user-package-db",@@ -251,17 +251,18 @@                 -> Either (IO ()) ([String], Config->Config) parseHasteFlags booting args rawargs = do   case runMode booting args of-   DontRun msg    -> Left $ putStrLn msg-   Run GHC        -> Left $ callVanillaGHC args-   Run Haste -> do-     case parseArgs hasteOpts helpHeader args of-       Left msg          -> Left $ putStrLn msg-       Right (cfg, rest) -> Right (filter (/= "-prof") rest, cfg)-   Run InstallJSExe -> do-     Left $ installJSExe (jsexeIn args) (jsexeOut args)-   Run BuildRunner -> do-     Left $ callVanillaGHC (rawargs ++ ["-package-id", "Cabal-1.23.0.0-f701f4ea98ec7bed5883c4df743045e6"])-   where+    DontRun msg -> Left $ putStrLn msg+    Run GHC     -> Left $ callVanillaGHC args+    Run Haste   -> do+      case parseArgs hasteOpts helpHeader args of+        Left msg              -> Left $ putStrLn msg+        Right (cfg, rest, []) -> Right (filter (/= "-prof") rest, cfg)+        Right (_, _,      es) -> Left (mapM_ putStr es >> exitFailure)+    Run InstallJSExe -> do+      Left $ installJSExe (jsexeIn args) (jsexeOut args)+    Run BuildRunner -> do+      Left $ callVanillaGHC (rawargs ++ ["-package-id", "Cabal-1.23.0.0-f701f4ea98ec7bed5883c4df743045e6"])+  where      jsexeIn ("--install-executable":exe:_) = exe      jsexeIn (_:xs)                         = jsexeIn xs      jsexeIn _                              = error "No executable to install!"