JsContracts 0.5.1 → 0.5.3

raw patch · 4 files changed

+67/−24 lines, 4 filesdep ~WebBits-HtmlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: WebBits-Html

API changes (from Hackage documentation)

Files

• JsContracts.cabal +19/−5
• data/contracts.js +17/−7
• src/BrownPLT/JavaScript/Contracts/Compiler.hs +19/−9
• src/Jscc.hs +12/−3

@@ -1,5 +1,5 @@ Name:           JsContracts-Version:        0.5.1+Version:        0.5.3 Cabal-Version:	>= 1.2.3 Copyright:      Copyright (c) 2008-2009 Arjun Guha and Spiridon Eliopoulos License:        BSD3@@ -20,8 +20,16 @@   Hs-Source-Dirs:     src   Build-Depends:-    base>=4 && < 5, mtl>=1.1.0.1, parsec<3.0.0, pretty>=0.1, containers>=0.1, syb>=0.1,-    WebBits==1.0, WebBits-Html==1.0, filepath, directory+    base >= 4 && < 5,+    mtl >= 1.1.0.1,+    parsec < 3.0.0,+    pretty >= 0.1,+    containers >= 0.1,+    syb >= 0.1,+    WebBits == 1.0,+    WebBits-Html == 1.0.1,+    filepath,+    directory   ghc-options:     -fwarn-incomplete-patterns   Extensions:     @@ -39,8 +47,14 @@   Main-Is: Jscc.hs   Hs-Source-Dirs: src   Build-Depends:-    base>=4 && < 5, mtl>=1.1.0.1, parsec<3.0.0, pretty>=0.1, containers>=0.1, syb>=0.1,-    WebBits==1.0, WebBits-Html==1.0+    base>=4 && < 5,+    mtl >= 1.1.0.1,+    parsec < 3.0.0, +    pretty >= 0.1,+    containers >= 0.1,+    syb >= 0.1,+    WebBits == 1.0,+    WebBits-Html == 1.0.1   ghc-options:     -fwarn-incomplete-patterns   Extensions:

@@ -1,3 +1,8 @@+// The type of a contract combinator is: name -> args ... -> contract+//+// name is a human-readable name for the contract.  args .. are constructor-+// specified arguments and contract is the resulting contract.+ var contracts = { };  contracts.map = function(f,arr) {@@ -8,14 +13,17 @@   return dest; }; + contracts.zipWith = function(f,arr1,arr2) {   var dest = [ ];-  for (var i = 0; i < arr1.length; i++) {+  var len = Math.min(arr1.length, arr2.length);+  for (var i = 0; i < len; i++) {     dest.push(f(arr1[i],arr2[i]));   }   return dest; }; + contracts.blame = function(guilty,expected,received,message,loc) {   var guiltyMsg = typeof(guilty) == "string"                      ? guilty : guilty.value;@@ -31,12 +39,7 @@   throw err; } -// The type of a contract combinator is: name -> args ... -> contract-//-// name is a human-readable name for the contract.  args .. are constructor--// specified arguments and contract is the resulting contract.  - contracts.flat = function(name) {   return function(pred) {     return {@@ -93,6 +96,7 @@   }; }; + contracts.fixedArray = function(name) {   return function() {     var elts = arguments;@@ -138,10 +142,12 @@   }; }; + contracts.isUndefined = contracts.flat(function(val) {    return val === undefined; }); + contracts.varArityFunc = function(name) {   return function(fixedArgs,restArgs,result) {     return {@@ -185,6 +191,7 @@   }; }; + // Ensures value is an instanceof constr before checking that its shape // matches sig. constrId is a human-readable name for the constructor. contracts.instance = function(name) {@@ -216,6 +223,7 @@   }; }; + contracts.obj = function(name) {   return function(sig) {     return {@@ -253,6 +261,7 @@   }; }; + // pos is the name of val.  neg should be the name of the calling context. // Since we do not rewrite call-sites, neg is simply "client". // However, if ctc.isHigherOrder, we can determine the name of the calling@@ -260,7 +269,7 @@ // if !ctc.isHigherOrder, the name of the calling context is the name of the // definition point (neg) contracts.guard = function(ctc,val,pos,neg,loc) {-  if (ctc.isHigherOrder) {+  if (false) {     if (typeof(val) != "function") {       contracts.blame(pos, "a function", ctc, "not a function","guard");      }@@ -277,6 +286,7 @@     return ctc.client(neg,loc)(ctc.server(pos,loc)(val));   } };+  // Derived from http://eriwen.com/javascript/js-stack-trace/ contracts.stackTrace = function() {

@@ -106,7 +106,11 @@   ExprStmt noPos $ AssignExpr noPos OpAssign      (LDot noPos (ThisRef noPos) id)     (DotRef noPos (VarRef noPos (Id noPos "impl")) (Id noPos id))-exportRelease _ = error "exportRelease: expected InterfaceItem"+exportRelease (InterfaceInstance id _ _) =+  ExprStmt noPos $ AssignExpr noPos OpAssign +    (LDot noPos (ThisRef noPos) id)+    (DotRef noPos (VarRef noPos (Id noPos "impl")) (Id noPos id))+exportRelease _ = error "exportRelease: expected InterfaceExport / Instance"   -- Given source that reads:@@ -183,10 +187,11 @@ compileRelease :: String -- ^implementation                -> String -- ^implementation source                -> String -- ^contract library+               -> Bool -- ^export?                -> [InterfaceItem] -- ^the interface                -> Maybe String -- ^the namespace name                -> String -- ^encapsulated implementation-compileRelease rawImpl implSource boilerplate interface namespace =+compileRelease rawImpl implSource boilerplate isExport interface namespace =   libraryHeader ++ (renderStatements $ escapeGlobals impl exportNames)      ++ rawImpl ++ exposeStatements ++ "\n}).apply(impl,[]);\n"      ++ exportStatements ++ namespaceStatements ++ "\n})();" where@@ -194,10 +199,12 @@               Left err -> error (show err)               Right (Script _ stmts) -> stmts      exports = filter isInterfaceExport interface-     exportStatements = renderStatements (map exportRelease exports)+     instances = filter isInterfaceInstance interface+     exportStatements = case isExport of+       True -> renderStatements (map exportRelease $ exports ++ instances)+       False -> ""      exportNames = [n | InterfaceExport n _ _ <- exports ]-     instanceNames = -       [n | InterfaceInstance n _ _ <- filter isInterfaceInstance interface]+     instanceNames =  [n | InterfaceInstance n _ _ <- instances]      exposeStatements = renderStatements        (exposeImplementation (exportNames ++ instanceNames))      namespaceStatements = case namespace of@@ -207,9 +214,10 @@ compileFormatted :: String -- ^implementation                  -> String -- ^implementation source                  -> String -- ^contract library+                 -> Bool -- ^export?                  -> [InterfaceItem] -- ^the interface                  -> String -- ^encapsulated implementation-compileFormatted rawImpl implSource boilerplate interface =+compileFormatted rawImpl implSource boilerplate isExport interface =   libraryHeader ++ (renderStatements $ escapeGlobals impl exportNames)      ++ rawImpl     ++ exposeStatements ++ "\n}).apply(impl,[]);\n" ++ boilerplate @@ -219,9 +227,11 @@      impl = case parseScriptFromString implSource rawImpl of               Left err -> error (show err)               Right (Script _ stmts) -> stmts-     exports = filter isInterfaceExport interface-     exportStatements = -       renderStatements (concatMap makeExportStatements interface)+     exports =filter isInterfaceExport interface+     instances = filter isInterfaceInstance interface+     exportStatements = case isExport of+       True -> renderStatements (concatMap makeExportStatements interface)+       False -> ""      exportNames = [n | InterfaceExport n _ _ <- exports ]      aliases = filter isInterfaceAlias interface      aliasStatements = renderStatements (compileAliases interface)

@@ -10,6 +10,7 @@ import BrownPLT.JavaScript.Contracts import Paths_JsContracts -- created by Cabal import BrownPLT.JavaScript.Parser (parseJavaScriptFromFile)+import Data.List  data Flag   = Help@@ -17,6 +18,7 @@   | Debug   | Namespace String   | Interface String+  | NoExport   deriving (Eq,Ord,Show)        @@ -30,6 +32,8 @@       "enable contracts and encapsulate (default)"   , Option ['n'] ["namespace"] (ReqArg Namespace "NAMESPACE")       "exports names to the namespace"+  , Option [] ["no-export"] (NoArg NoExport)+     "do not export names to the global object"   , Option ['i'] ["interface"] (ReqArg Interface "PATH")       "path to the interface; uses module.jsi by default"   ]@@ -40,7 +44,8 @@ main = do   args <- getArgs   dataDir <- getDataDir-  let (opts, nonOpts, errors) = getOpt RequireOrder options args+  let (opts', nonOpts, errors) = getOpt Permute options args+  let opts = sort opts'   unless (null errors) $ do     mapM_ putStrLn  errors     fail "jscc terminated"@@ -48,6 +53,7 @@   (isDebugMode, opts) <- getDebugMode opts   (namespace, opts) <- getNamespace opts   (ifacePath, opts) <- getInterfacePath opts nonOpts+  (isExport, opts) <- getExportGlobals opts   when (not $ null opts) $ do     putStrLn $ "spurious arguments: " ++ (show opts)     fail "jscc terminated"@@ -60,9 +66,9 @@       interface <- parseInterface ifacePath       let result = if isDebugMode                      then compileFormatted rawImpl implPath rawBoilerplate -                            interface+                            isExport interface                      else compileRelease rawImpl implPath rawBoilerplate-                            interface namespace+                            isExport interface namespace       putStrLn result       return ()      otherwise -> do@@ -86,6 +92,9 @@   putStrLn usage   exitSuccess checkHelp _ = return ()++getExportGlobals (NoExport:rest) = return (False, rest)+getExportGlobals rest = return (True, rest)  getInterfacePath :: [Flag] -> [String] -> IO (FilePath,[Flag]) getInterfacePath (Interface path:rest) _ = do