jespresso 1.0 → 1.0.1
raw patch · 10 files changed
+126/−100 lines, 10 filesdep +Diffdep +data-default-instances-basedep ~language-ecmascriptdep ~tastydep ~tasty-golden
Dependencies added: Diff, data-default-instances-base
Dependency ranges changed: language-ecmascript, tasty, tasty-golden
Files
- LICENSE +1/−1
- jespresso.cabal +31/−29
- src/Text/Html/Consolidate.hs +37/−24
- test-data/cases/complex1.html +7/−6
- test-data/cases/form1.html +2/−1
- test-data/cases/scriptSimple1.html +3/−0
- test-data/expects/complex1.html +33/−32
- test-data/expects/form1.html +4/−2
- test-data/expects/scriptSimple1.html +2/−0
- test/UnitTest.hs +6/−5
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012-2013 Stevens Institute of Technology+Copyright (c) 2012-2015 Stevens Institute of Technology All rights reserved.
jespresso.cabal view
@@ -2,16 +2,16 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: jespresso-version: 1.0+version: 1.0.1 synopsis: Extract all JavaScript from an HTML page and consolidate it in one script.-description: Allows extraction and consolidation of JavaScript code in an HTML page so that it behaves like the original. Consolidation is a process of transforming an HTML page into an equivalent, but containing JavaScript code only in one inlined script tag.+description: Allows extraction and consolidation of JavaScript code in an HTML page so that it behaves like the original. Consolidation is a process of transforming an HTML page into an equivalent, but containing JavaScript code only in one inlined script tag. Note that the package versions follow Semantic Versioning model (semver.org). license: BSD3 license-file: LICENSE author: Andrey Chudnov maintainer: Andrey Chudnov <oss@chudnov.com> Homepage: http://github.com/achudnov/jespresso Bug-reports: http://github.com/achudnov/jespresso/issues-copyright: (c) 2012-2014 Stevens Institute of Technology+copyright: (c) 2012-2015 Stevens Institute of Technology category: Web stability: Experimental tested-with: GHC==7.6.3@@ -26,20 +26,21 @@ Source-repository this type: git location: git://github.com/achudnov/jespresso.git- tag: 1.0+ tag: 1.0.1 library- build-depends: base >=4.2.0 && < 5- ,hxt >= 9.2.0 && < 10- ,hxt-tagsoup >= 9.1.1 && < 10- ,arrows >= 0.4 && < 0.5- ,HTTP >= 4000.2.0 && < 5000- ,language-ecmascript >= 0.15 && < 1.0- ,random >= 1 && < 2- ,bytestring >= 0.9 && < 0.11- ,http-encodings >= 0.9.1 && < 1.0- ,network >= 2.4 && < 2.5- ,data-default-class >= 0.0.1 && < 0.1+ build-depends: base >= 4.2.0 && < 5+ , hxt >= 9.2.0 && < 10+ , hxt-tagsoup >= 9.1.1 && < 10+ , arrows >= 0.4 && < 0.5+ , HTTP >= 4000.2.0 && < 5000+ , language-ecmascript >= 0.17 && < 1.0+ , random >= 1 && < 2+ , bytestring >= 0.9 && < 0.11+ , http-encodings >= 0.9.1 && < 1.0+ , network >= 2.4 && < 2.5+ , data-default-class >= 0.0.1 && < 0.1+ , data-default-instances-base >= 0.0.1 && < 0.1 exposed-modules: Text.Html.Consolidate Network.Browser.Simple hs-source-dirs: src@@ -47,24 +48,25 @@ executable jespresso main-is: Main.hs- build-depends: base >=4.2.0 && < 5- ,jespresso- ,cmdargs >= 0.9 && < 0.11- ,HTTP >= 4000.2.0 && < 5000- ,network >= 2.4 && < 2.5+ build-depends: base >=4.2.0 && < 5+ , jespresso+ , cmdargs >= 0.9 && < 0.11+ , HTTP >= 4000.2.0 && < 5000+ , network >= 2.4 && < 2.5 default-language: Haskell2010 Test-Suite unittest Hs-Source-Dirs: test Type: exitcode-stdio-1.0 Main-Is: UnitTest.hs- Build-Depends: base >= 4 && < 5- ,jespresso- ,tasty >= 0.4 && < 0.8- ,tasty-golden >= 2.2 && < 2.3- ,directory >= 1.2 && < 1.3- ,filepath >= 1.1 && < 1.4- ,hxt >= 9.2.0 && < 10- ,arrows >= 0.4 && < 0.5- ,transformers >= 0.3 && < 0.4+ Build-Depends: base >= 4 && < 5+ , jespresso+ , tasty >= 0.4 && < 0.11+ , tasty-golden == 2.*+ , directory >= 1.2 && < 1.3+ , filepath >= 1.1 && < 1.4+ , hxt >= 9.2.0 && < 10+ , arrows >= 0.4 && < 0.5+ , transformers >= 0.3 && < 0.4+ , Diff >= 0.3.0 Default-Language: Haskell2010
src/Text/Html/Consolidate.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE Arrows #-}+{-# LANGUAGE OverloadedStrings #-} -- | Extraction and consolidation of JavaScript code in an HTML page. module Text.Html.Consolidate (-- * Simple API consolidate@@ -21,6 +22,7 @@ import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.TagSoup import Language.ECMAScript3.Syntax+import Language.ECMAScript3.Syntax.CodeGen hiding (this) import Language.ECMAScript3.Syntax.Annotations import Language.ECMAScript3.PrettyPrint import Language.ECMAScript3.Parser@@ -34,8 +36,10 @@ import Data.ByteString.Lazy (ByteString) import System.Random import Data.Char-import Data.Maybe (isJust, fromJust, maybeToList)+import Data.Maybe (isJust, fromJust, maybeToList, fromMaybe) import Control.Monad hiding (when)+import Data.Default.Instances.Base+import Control.Applicative ((<$>)) -- | Consolidation state data ConsState = ConsState Bool -- Ignore errors?@@ -76,7 +80,13 @@ renderHTML :: ConsState -> TArr XmlTree XmlTree -> IO String renderHTML ns a = let state = initialState ns- in liftM head $ runXIOState state (single a >>> writeDocumentToString [withOutputHTML, withOutputEncoding utf8])+ in liftM head $ runXIOState state (single a >>> writeDocumentToString+ -- Using plain text output to+ -- prevent entity substitution on+ -- special XML/HTML characters+ -- that are part of inline+ -- scripts+ [withOutputPLAIN, withOutputEncoding utf8]) -- | Takes an HTML page source as a string and an optional base URI -- (for resolving relative URI's) and produces an HTML page with all@@ -222,8 +232,7 @@ -- isElem >>> -- selectTags ["img", "a", "form", "frame", "iframe", "link"] >>> addIdIfNotPresent >>>- (((selectAttrValues ["src", "href", "action"] - &&& selectId) >>>+ (((selectAttrValues ["src", "href", "action"] &&& selectId) >>> arr (\((url, attrName), id) -> Script () [ExprStmt () $ AssignExpr () OpAssign (LDot () (CallExpr ()@@ -245,19 +254,29 @@ "onmouseenter", "onmouseleave", "onmousemove", "onmouseout", "onmouseover", "onmouseup", "onreset", "onresize","onscroll", "onselect", "onsubmit", "ontextinput", "onunload", "onwheel"]- -- in isElem >>>- -- hasAnyAttrs attrNames >>>- in addIdIfNotPresent >>>- (((selectAttrValues attrNames &&& selectId) >>>- arr (\((handler, attrName), id) ->- Script () [ExprStmt () $ AssignExpr () OpAssign - (LDot () (CallExpr ()- (DotRef () (VarRef () (Id () "document")) (Id () "getElementById"))- [StringLit () id]) attrName) (StringLit () handler)])+ in addIdIfNotPresent >>>+ (((selectId &&& selectAttrValues attrNames) >>>+ arr (\(id, (handler, attrName)) -> makeHandler id attrName handler) >>> appendScript) &&& removeAttributes attrNames) >>> arr snd +makeHandler :: Default a => String -> String -> String -> JavaScript a+makeHandler id handlerName handlerSource =+ let mEventName = case handlerName of+ 'o':'n':s | not $ null s -> Just s+ _ -> Nothing+ either2maybe (Left _) = Nothing+ either2maybe (Right x)= Just x+ in fromMaybe (script []) $+ do eventName <- mEventName+ h <- either2maybe $ reannotate def <$> parseFromString handlerSource+ return $ script [expr $ call (+ call (var "document" `dot` "getElementById") [string id]+ `dot` "addEventListener")+ [string eventName, lambda [] $ unJavaScript h, bool False]+ ]+ parseJS :: TArr String (JavaScript SourcePos) parseJS = arr (parse program "") >>> eitherToFailure @@ -348,19 +367,13 @@ f a attr = a <+> hasAttr attr removeAttributes :: ArrowXml a => [String] -> a XmlTree XmlTree-removeAttributes = foldl f zeroArrow- where f :: ArrowXml a => a XmlTree XmlTree -> String -> a XmlTree XmlTree- f a attr = a >>> removeAttr attr+removeAttributes names =+ processAttrl $ none `when` (foldr (\n a -> a <+> hasName n) none names) - addIdIfNotPresent :: TArr XmlTree XmlTree-addIdIfNotPresent = proc node -> do- idval <- getAttrValue "id" -< node- if null idval- then replaceChildren repFun -< node- else returnA -< node- where repFun = replaceChildren (genIdA >>> mkText)- `when` (isAttr >>> hasName "id")+addIdIfNotPresent =+ ((genIdA &&& this) >>> (arr2A $ addAttr "id")) `when`+ (getAttrValue "id" >>> isA null) -- | Selects the id of an element or adds a new one (and returns) if -- it's not present
test-data/cases/complex1.html view
@@ -42,11 +42,10 @@ alert("Received invalid confirmation from the payment service. Please try again"); } if (confirmation) {- /*if (confirmation.transaction_id * confirmation.amount * key == - confirmation.signature) {*/ if (confirmation.signature == 42) { alert("Your order has been confirmed! Thank you!");- } else alert("Received invalid confirmation from the payment service. Please try again");+ } + else alert("Received invalid confirmation from the payment service. Please try again"); } } function onCartUpdate(e) {@@ -57,10 +56,12 @@ parseInt(rows[i].cells[2].firstChild.value); } var w = document.getElementById("payment_frame").contentWindow;- w.postMessage(total.toString(), "http://chudnov.com");- if(e.preventDefault) e.preventDefault();+ w.postMessage(total.toString(),+ "http://chudnov.com");+ if(e.preventDefault) + e.preventDefault(); e.returnValue=false;- }, true);+ } </script> </div> <iframe src="http://chudnov.com/research/jsinline/examples/mashups/payment/iframe/payment.html"
test-data/cases/form1.html view
@@ -1,6 +1,7 @@ <html> <body>- <form>+ <form id="f1" onsubmit="alert('submit')">+ <input type="submit" value="OK"/> </form> </body> </html>
test-data/cases/scriptSimple1.html view
@@ -8,6 +8,9 @@ <script> foo(bar); </script>+ <script>+ bar = baz;+ </script> <span>Test</span> </body> </html>
test-data/expects/complex1.html view
@@ -7,7 +7,7 @@ <body> <div id="order_summary"> <h1>Your order summary</h1>- <form id="cart_form" onsubmit="onCartUpdate()">+ <form id="cart_form"> <table id="cart"> <thead> <tr>@@ -31,38 +31,39 @@ </table> <input type="submit" value="Update total"/> </form>- <script type="text/javascript">- var key = 42;- window.onmessage = function (e) {- var confirmation;- try {- confirmation = JSON.parse(e.data);- } catch (e) {- alert("Received invalid confirmation from the payment service. Please try again");- }- if (confirmation) {- /*if (confirmation.transaction_id * confirmation.amount * key == - confirmation.signature) {*/- if (confirmation.signature == 42) {- alert("Your order has been confirmed! Thank you!");- } else alert("Received invalid confirmation from the payment service. Please try again");- }- }- function onCartUpdate(e) {- var total = 0;- rows = document.getElementById("cart").tBodies[0].rows;- for (var i = 0; i < rows.length; i++) {- total += parseInt(rows[i].cells[1].firstChild.data)*- parseInt(rows[i].cells[2].firstChild.value);- }- var w = document.getElementById("payment_frame").contentWindow;- w.postMessage(total.toString(), "http://chudnov.com");- if(e.preventDefault) e.preventDefault();- e.returnValue=false;- }, true);- </script>+ <!--Removed Inline Script--> </div> <iframe id="payment_frame"> </iframe>- <script type="text/javascript"></script></body>+ <script type="text/javascript">+ document.getElementById("cart_form").addEventListener("submit", function () {onCartUpdate();}, false);+ var key = 42;+ window.onmessage = function (e) {+ var confirmation;+ try {+ confirmation = JSON.parse(e.data);+ } catch (e) {+ alert("Received invalid confirmation from the payment service. Please try again");+ }+ if (confirmation) {+ if (confirmation.signature == 42) {+ alert("Your order has been confirmed! Thank you!");+ } else alert("Received invalid confirmation from the payment service. Please try again");+ }+ };+ function onCartUpdate(e) {+ var total = 0;+ rows = document.getElementById("cart").tBodies[0].rows;+ for (var i = 0; i < rows.length; i++) {+ total += parseInt(rows[i].cells[1].firstChild.data)*+ parseInt(rows[i].cells[2].firstChild.value);+ }+ var w = document.getElementById("payment_frame").contentWindow;+ w.postMessage(total.toString(), "http://chudnov.com");+ if(e.preventDefault) e.preventDefault();+ e.returnValue=false;+ }+ (document.getElementById("payment_frame")).src = "http://chudnov.com/research/jsinline/examples/mashups/payment/iframe/payment.html";+ </script>+ </body> </html>
test-data/expects/form1.html view
@@ -1,6 +1,8 @@ <html> <body>- <form>+ <form id="f1">+ <input type="submit" value="OK"/> </form>- <script type="text/javascript"></script></body>+ <script type="text/javascript">document.getElementById("f1").addEventListener("submit", function () {alert("submit");}, false);</script>+</body> </html>
test-data/expects/scriptSimple1.html view
@@ -5,9 +5,11 @@ </head> <body> <!--Removed Inline Script-->+ <!--Removed Inline Script--> <span>Test</span> <script type="text/javascript"> foo(bar);+ bar = baz; </script> </body> </html>
test/UnitTest.hs view
@@ -15,6 +15,8 @@ import Control.Monad import Data.Char import Control.Monad.IO.Class+import Data.Algorithm.Diff+import Data.Algorithm.DiffOutput main = do allCases <- getDirectoryContents casesDir allExpects <- getDirectoryContents expectsDir@@ -22,7 +24,7 @@ let validExpects = getValid allExpects defaultMain $ testGroup "Tests" $ map genTest $ filter (`elem` validExpects) validCases- where getValid = filter $ \x -> FP.takeExtension x == ".js"+ where getValid = filter $ \x -> FP.takeExtension x == ".html" casesDir = "test-data/cases" expectsDir = "test-data/expects"@@ -35,15 +37,14 @@ state = initialState ns normalizedA :: String -> TArr XmlTree XmlTree normalizedA s = single $ parseHTML s Nothing >>> consolidateArr- expectedA :: String -> TArr XmlTree XmlTree - expectedA s = single $ parseHTML s Nothing runX :: forall r s. (String -> TArr XmlTree XmlTree) -> FilePath -> ValueGetter r String runX a f = liftIO $ do s <- readFile f let arr :: TArr XmlTree String arr = (a s) >>> writeDocumentToString [withOutputHTML, withOutputEncoding utf8] liftM head $ runXIOState state $ arr- expectedValueAction = runX expectedA expectFileName+ expectedValueAction :: forall r. ValueGetter r String+ expectedValueAction = liftIO $ readFile expectFileName testValueAction = runX normalizedA caseFileName in goldenTest testFileName expectedValueAction testValueAction verifyOutput (const $ return ()) @@ -51,6 +52,6 @@ verifyOutput expected actual = return $ let fs = filter (not . isSpace) msg = "Failed to match expected output to normalized input:\n\- \Expected:\n" ++ expected ++ "\n\nSaw:\n" ++ actual ++ "\n"+ \Diff:\n" ++ ppDiff (getGroupedDiff (lines expected) (lines actual)) in if (fs expected == fs actual) then Nothing else Just msg