From 23461ba532ab9295e382826f479ee6fe0a28e26f Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 26 Oct 2017 18:54:14 +0100 Subject: [PATCH 1/2] Add document readyState And make it so test failures actually fail the tests --- package.json | 2 +- src/DOM/HTML/Document.js | 6 +++ src/DOM/HTML/Document.purs | 15 ++++++- src/DOM/HTML/Document/ReadyState.purs | 60 +++++++++++++++++++++++++++ test/DOM/HTML/Document.purs | 18 ++++++++ test/Main.purs | 30 ++++---------- 6 files changed, 107 insertions(+), 24 deletions(-) create mode 100644 src/DOM/HTML/Document/ReadyState.purs create mode 100644 test/DOM/HTML/Document.purs diff --git a/package.json b/package.json index bbb47ef..11acf56 100644 --- a/package.json +++ b/package.json @@ -3,7 +3,7 @@ "scripts": { "clean": "rimraf output && rimraf .pulp-cache", "build": "eslint src && pulp build -- --censor-lib --strict", - "test": "PHANTOM_TEST_PATH=$(pwd) pulp test --runtime phantomjs" + "test": "pulp test --runtime phantomjs" }, "devDependencies": { "eslint": "^3.19.0", diff --git a/src/DOM/HTML/Document.js b/src/DOM/HTML/Document.js index 7d23ab1..306dfa1 100644 --- a/src/DOM/HTML/Document.js +++ b/src/DOM/HTML/Document.js @@ -5,3 +5,9 @@ exports._body = function (doc) { return doc.body; }; }; + +exports._readyState = function (doc) { + return function () { + return doc.readyState; + }; +}; diff --git a/src/DOM/HTML/Document.purs b/src/DOM/HTML/Document.purs index d4115c7..553797a 100644 --- a/src/DOM/HTML/Document.purs +++ b/src/DOM/HTML/Document.purs @@ -1,15 +1,26 @@ module DOM.HTML.Document ( body + , readyState + , module Exports ) where import Prelude + import Control.Monad.Eff (Eff) -import Data.Maybe (Maybe) -import Data.Nullable (Nullable, toMaybe) import DOM (DOM) +import DOM.HTML.Document.ReadyState (ReadyState(..)) as Exports +import DOM.HTML.Document.ReadyState (ReadyState, parseReadyState) import DOM.HTML.Types (HTMLElement, HTMLDocument) +import Data.Maybe (Maybe, fromJust) +import Data.Nullable (Nullable, toMaybe) +import Partial.Unsafe (unsafePartial) foreign import _body :: forall eff. HTMLDocument -> Eff (dom :: DOM | eff) (Nullable HTMLElement) body :: forall eff. HTMLDocument -> Eff (dom :: DOM | eff) (Maybe HTMLElement) body = map toMaybe <<< _body + +foreign import _readyState :: forall eff. HTMLDocument -> Eff (dom :: DOM | eff) String + +readyState :: forall eff. HTMLDocument -> Eff (dom :: DOM | eff) ReadyState +readyState = map (unsafePartial fromJust <<< parseReadyState) <<< _readyState diff --git a/src/DOM/HTML/Document/ReadyState.purs b/src/DOM/HTML/Document/ReadyState.purs new file mode 100644 index 0000000..10c903a --- /dev/null +++ b/src/DOM/HTML/Document/ReadyState.purs @@ -0,0 +1,60 @@ +module DOM.HTML.Document.ReadyState where + +import Prelude +import Data.Enum (class Enum, class BoundedEnum, Cardinality(..), defaultSucc, defaultPred) +import Data.Maybe (Maybe(..)) + +data ReadyState + = Loading + | Interactive + | Complete + +derive instance eqReadyState :: Eq ReadyState +derive instance ordReadyState :: Ord ReadyState + +instance showReadyState :: Show ReadyState where + show = case _ of + Loading -> "Loading" + Interactive -> "Interactive" + Complete -> "Complete" + +printReadyState :: ReadyState -> String +printReadyState = case _ of + Loading -> "loading" + Interactive -> "interactive" + Complete -> "complete" + +parseReadyState :: String -> Maybe ReadyState +parseReadyState = case _ of + "loading" -> Just Loading + "interactive" -> Just Interactive + "complete" -> Just Complete + _ -> Nothing + +instance boundedReadyState :: Bounded ReadyState where + bottom = Loading + top = Complete + +instance enumReadyState :: Enum ReadyState where + succ = defaultSucc toEnumReadyState fromEnumReadyState + pred = defaultPred toEnumReadyState fromEnumReadyState + +instance boundedEnumReadyState :: BoundedEnum ReadyState where + cardinality = Cardinality 3 + toEnum = toEnumReadyState + fromEnum = fromEnumReadyState + +toEnumReadyState :: Int -> Maybe ReadyState +toEnumReadyState = + case _ of + 0 -> Just Loading + 1 -> Just Interactive + 2 -> Just Complete + _ -> Nothing + +fromEnumReadyState :: ReadyState -> Int +fromEnumReadyState = + case _ of + Loading -> 0 + Interactive -> 1 + Complete -> 2 diff --git a/test/DOM/HTML/Document.purs b/test/DOM/HTML/Document.purs new file mode 100644 index 0000000..a129ce1 --- /dev/null +++ b/test/DOM/HTML/Document.purs @@ -0,0 +1,18 @@ +module Test.DOM.HTML.Document where + +import Prelude + +import Control.Monad.Eff.Class (liftEff) +import DOM (DOM) +import DOM.HTML (window) +import DOM.HTML.Document (ReadyState(..), readyState) +import DOM.HTML.Window (document) +import Test.Unit (TestSuite, describe, it) +import Test.Unit.Assert (shouldEqual) + +domHtmlDocumentTests :: forall eff. TestSuite (dom :: DOM | eff) +domHtmlDocumentTests = do + describe "readyState" do + it "should return a sensible readyState" do + rs <- liftEff $ readyState =<< document =<< window + rs `shouldEqual` Interactive diff --git a/test/Main.purs b/test/Main.purs index 13c0c44..404f158 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,32 +1,20 @@ module Test.Main where -import Prelude (($), discard) -import Control.Monad.Aff (launchAff, Canceler) +import Prelude + import Control.Monad.Aff.AVar (AVAR) +import Control.Monad.Aff.Console (CONSOLE) import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Class (liftEff) -import Control.Monad.Eff.Console (CONSOLE) -import Control.Monad.Eff.Exception (EXCEPTION) import DOM (DOM) import DOM.HTML.Types (WINDOW) -import Data.Enum (fromEnum) -import ExitCodes (ExitCode(Success)) -import PhantomJS.Phantom (exit, PHANTOMJS) +import Test.DOM.HTML.Document (domHtmlDocumentTests) import Test.DOM.HTML.Window (domHtmlWindowTests) import Test.DOM.Node.DOMTokenList (domTokenListTests) -import Test.Unit (describe, it) -import Test.Unit.Assert (assert) -import Test.Unit.Output.Simple (runTest) +import Test.Unit.Console (TESTOUTPUT) +import Test.Unit.Main (runTest) -main - :: forall eff - . Eff (exception :: EXCEPTION, console :: CONSOLE, avar :: AVAR, dom :: DOM, window :: WINDOW, phantomjs :: PHANTOMJS | eff) - (Canceler (console :: CONSOLE, avar :: AVAR, dom :: DOM, window :: WINDOW, phantomjs :: PHANTOMJS | eff)) -main = launchAff $ runTest do +main :: forall eff. Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR, dom :: DOM, window :: WINDOW | eff) Unit +main = runTest do + domHtmlDocumentTests domHtmlWindowTests domTokenListTests - - describe "exit" $ do - it "should exit" $ do - liftEff $ exit (fromEnum Success) - assert "failed to exit phantomjs" false From 92c7b6a0ecaaee8db9d66cc532e61f8b86d3cffd Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 26 Oct 2017 19:01:28 +0100 Subject: [PATCH 2/2] Tidy up various things in the tests --- test/DOM/HTML/Document.purs | 2 +- test/DOM/HTML/Window.purs | 46 +++------- test/DOM/Node/DomTokenList.purs | 157 +++++++++++++++----------------- test/Main.purs | 15 +-- 4 files changed, 93 insertions(+), 127 deletions(-) diff --git a/test/DOM/HTML/Document.purs b/test/DOM/HTML/Document.purs index a129ce1..d5b5005 100644 --- a/test/DOM/HTML/Document.purs +++ b/test/DOM/HTML/Document.purs @@ -15,4 +15,4 @@ domHtmlDocumentTests = do describe "readyState" do it "should return a sensible readyState" do rs <- liftEff $ readyState =<< document =<< window - rs `shouldEqual` Interactive + rs `shouldEqual` Complete diff --git a/test/DOM/HTML/Window.purs b/test/DOM/HTML/Window.purs index 12bdbe7..c660a90 100644 --- a/test/DOM/HTML/Window.purs +++ b/test/DOM/HTML/Window.purs @@ -1,61 +1,39 @@ module Test.DOM.HTML.Window where -import Prelude (Unit, bind, (<<<), discard) +import Prelude + +import Control.Monad.Eff.Class (liftEff) import DOM (DOM) import DOM.HTML (window) import DOM.HTML.Types (WINDOW) -import DOM.HTML.Window -import Control.Monad.Free (Free) -import Control.Monad.Aff (Aff) -import Control.Monad.Aff.Console (CONSOLE) -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Class (liftEff) as EffClass -import Test.Unit (TestF, describe, it) -import Test.Unit.Assert (shouldEqual) +import DOM.HTML.Window as Window import Data.Maybe (isJust) -import Data.Traversable (class Traversable, sequence) - - -liftEff :: forall eff a. Eff eff a -> Aff eff a -liftEff = EffClass.liftEff - -liftSeq :: forall eff m a. Traversable m => m (Eff eff a) -> Aff eff (m a) -liftSeq = liftEff <<< sequence +import Test.Unit (TestSuite, describe, it) +import Test.Unit.Assert (shouldEqual) -domHtmlWindowTests - :: forall eff. Free (TestF (dom :: DOM, console :: CONSOLE, window :: WINDOW | eff)) Unit +domHtmlWindowTests :: forall eff. TestSuite (dom :: DOM, window :: WINDOW | eff) domHtmlWindowTests = do describe "innerHeight" do it "should return the default inner height" do - windowHeight <- liftEff do - window' <- window - innerHeight window' + windowHeight <- liftEff $ Window.innerHeight =<< window windowHeight `shouldEqual` 300 describe "innerWidth" do it "should return the default inner width" do - windowWidth <- liftEff do - window' <- window - innerWidth window' + windowWidth <- liftEff $ Window.innerWidth =<< window windowWidth `shouldEqual` 400 describe "screenX" do it "should get the X coordinate of the window" do - x <- liftEff do - window' <- window - screenX window' + x <- liftEff $ Window.screenX =<< window x `shouldEqual` 0 describe "screenY" do it "should get the Y coordinate of the window" do - y <- liftEff do - window' <- window - screenY window' + y <- liftEff $ Window.screenY =<< window y `shouldEqual` 0 describe "open" do it "should open a new window" do - newWindow' <- liftEff do - window' <- window - open "about:blank" "foobar" "" window' + newWindow' <- liftEff $ Window.open "about:blank" "foobar" "" =<< window isJust newWindow' `shouldEqual` true diff --git a/test/DOM/Node/DomTokenList.purs b/test/DOM/Node/DomTokenList.purs index 88b1885..96195ea 100644 --- a/test/DOM/Node/DomTokenList.purs +++ b/test/DOM/Node/DomTokenList.purs @@ -2,154 +2,139 @@ module Test.DOM.Node.DOMTokenList where import Prelude -import Control.Monad.Aff.Console (CONSOLE) import Control.Monad.Eff.Class (liftEff) -import Control.Monad.Free (Free) import DOM (DOM) import DOM.HTML (window) import DOM.HTML.Document (body) import DOM.HTML.HTMLElement (classList, className, setClassName) -import DOM.HTML.Types (WINDOW) import DOM.HTML.Window (document) -import DOM.Node.ClassList (add, contains, remove, toggle, toggleForce, item) as CL +import DOM.Node.ClassList as CL import Data.Maybe (Maybe(..), fromMaybe) -import Test.Unit (TestF, describe, it) +import Test.Unit (TestSuite, describe, it) import Test.Unit.Assert (shouldEqual) -domTokenListTests :: forall eff. Free (TestF (dom :: DOM, console :: CONSOLE, - window :: WINDOW | eff)) Unit +domTokenListTests :: forall eff. TestSuite (dom :: DOM | eff) domTokenListTests = do describe "DOMTokenList of classList" do it "contains a token" do body' <- liftEff $ window >>= document >>= body result <- case body' of - Just body'' -> liftEff do - _ <- setClassName "a b c" body'' - list <- classList body'' - CL.contains list "a" - Nothing -> pure false - + Just body'' -> liftEff do + _ <- setClassName "a b c" body'' + list <- classList body'' + CL.contains list "a" + Nothing -> pure false result `shouldEqual` true it "adds a token" do body' <- liftEff $ window >>= document >>= body result <- case body' of - Just body'' -> liftEff do - -- clear class names, first - _ <- setClassName "" body'' - list <- classList body'' - _ <- CL.add list "a" - className body'' - Nothing -> pure "failed" - + Just body'' -> liftEff do + -- clear class names, first + _ <- setClassName "" body'' + list <- classList body'' + _ <- CL.add list "a" + className body'' + Nothing -> pure "failed" result `shouldEqual` "a" it "removes a token" do body' <- liftEff $ window >>= document >>= body result <- case body' of - Just body'' -> liftEff do - _ <- setClassName "a b c" body'' - list <- classList body'' - _ <- CL.remove list "b" - resultA <- CL.contains list "a" - resultB <- CL.contains list "b" - resultC <- CL.contains list "c" - -- Only "b" should be removed - pure $ resultA && not resultB && resultC - Nothing -> pure false - + Just body'' -> liftEff do + _ <- setClassName "a b c" body'' + list <- classList body'' + _ <- CL.remove list "b" + resultA <- CL.contains list "a" + resultB <- CL.contains list "b" + resultC <- CL.contains list "c" + -- Only "b" should be removed + pure $ resultA && not resultB && resultC + Nothing -> pure false result `shouldEqual` true it "toggles a token by removing its value" do body' <- liftEff $ window >>= document >>= body result <- case body' of - Just body'' -> liftEff do - _ <- setClassName "a b c" body'' - list <- classList body'' - _ <- CL.toggle list "c" - className body'' - Nothing -> pure "failed" - + Just body'' -> liftEff do + _ <- setClassName "a b c" body'' + list <- classList body'' + _ <- CL.toggle list "c" + className body'' + Nothing -> pure "failed" result `shouldEqual` "a b" it "toggles a token by adding its value" do body' <- liftEff $ window >>= document >>= body result <- case body' of - Just body'' -> liftEff do - _ <- setClassName "a b" body'' - list <- classList body'' - _ <- CL.toggle list "c" - className body'' - Nothing -> pure "failed" - + Just body'' -> liftEff do + _ <- setClassName "a b" body'' + list <- classList body'' + _ <- CL.toggle list "c" + className body'' + Nothing -> pure "failed" result `shouldEqual` "a b c" it "toggles a token by forcing to add its value" do body' <- liftEff $ window >>= document >>= body result <- case body' of - Just body'' -> liftEff do - _ <- setClassName "a b" body'' - list <- classList body'' - _ <- CL.toggleForce list "c" true - className body'' - Nothing -> pure "failed" - + Just body'' -> liftEff do + _ <- setClassName "a b" body'' + list <- classList body'' + _ <- CL.toggleForce list "c" true + className body'' + Nothing -> pure "failed" result `shouldEqual` "a b c" it "toggles a token by forcing to add (but not to remove) its value" do body' <- liftEff $ window >>= document >>= body result <- case body' of - Just body'' -> liftEff do - _ <- setClassName "a b c" body'' - list <- classList body'' - _ <- CL.toggleForce list "c" true - className body'' - Nothing -> pure "failed" - + Just body'' -> liftEff do + _ <- setClassName "a b c" body'' + list <- classList body'' + _ <- CL.toggleForce list "c" true + className body'' + Nothing -> pure "failed" result `shouldEqual` "a b c" it "toggles a token by forcing to remove its value" do body' <- liftEff $ window >>= document >>= body result <- case body' of - Just body'' -> liftEff do - _ <- setClassName "a b c" body'' - list <- classList body'' - _ <- CL.toggleForce list "c" false - className body'' - Nothing -> pure "failed" - + Just body'' -> liftEff do + _ <- setClassName "a b c" body'' + list <- classList body'' + _ <- CL.toggleForce list "c" false + className body'' + Nothing -> pure "failed" result `shouldEqual` "a b" it "toggles a token by forcing to remove (but not to add) its value" do body' <- liftEff $ window >>= document >>= body result <- case body' of - Just body'' -> liftEff do - _ <- setClassName "a b" body'' - list <- classList body'' - _ <- CL.toggleForce list "c" false - className body'' - Nothing -> pure "failed" - + Just body'' -> liftEff do + _ <- setClassName "a b" body'' + list <- classList body'' + _ <- CL.toggleForce list "c" false + className body'' + Nothing -> pure "failed" result `shouldEqual` "a b" it "returns an item if available" do body' <- liftEff $ window >>= document >>= body result <- case body' of - Just body'' -> liftEff do - _ <- setClassName "a b c" body'' - list <- classList body'' - CL.item list 2 - Nothing -> pure Nothing - + Just body'' -> liftEff do + _ <- setClassName "a b c" body'' + list <- classList body'' + CL.item list 2 + Nothing -> pure Nothing (fromMaybe "not found" result) `shouldEqual` "c" it "returns not an item if it's not available" do body' <- liftEff $ window >>= document >>= body result <- case body' of - Just body'' -> liftEff do - _ <- setClassName "a b c" body'' - list <- classList body'' - CL.item list 5 - Nothing -> pure Nothing - + Just body'' -> liftEff do + _ <- setClassName "a b c" body'' + list <- classList body'' + CL.item list 5 + Nothing -> pure Nothing (fromMaybe "not found" result) `shouldEqual` "not found" diff --git a/test/Main.purs b/test/Main.purs index 404f158..94c255b 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -5,16 +5,19 @@ import Prelude import Control.Monad.Aff.AVar (AVAR) import Control.Monad.Aff.Console (CONSOLE) import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Timer (TIMER, setTimeout) import DOM (DOM) import DOM.HTML.Types (WINDOW) import Test.DOM.HTML.Document (domHtmlDocumentTests) import Test.DOM.HTML.Window (domHtmlWindowTests) import Test.DOM.Node.DOMTokenList (domTokenListTests) import Test.Unit.Console (TESTOUTPUT) -import Test.Unit.Main (runTest) +import Test.Unit.Main (runTest, exit) -main :: forall eff. Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR, dom :: DOM, window :: WINDOW | eff) Unit -main = runTest do - domHtmlDocumentTests - domHtmlWindowTests - domTokenListTests +main :: Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR, dom :: DOM, window :: WINDOW, timer :: TIMER) Unit +main = do + runTest do + domHtmlDocumentTests + domHtmlWindowTests + domTokenListTests + void $ setTimeout 100 $ exit 0