Merge pull request #129 from purescript-web/readyState

Add document ReadyState

Author: garyb

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",

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;
+  };
+};

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

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

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` Complete

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