ScreenOrientation support

W3 spec for `ScreenOrientation`: https://drafts.csswg.org/cssom-view/

Author: toastal

bower.json

@@ -15,6 +15,7 @@
     "package.json"
   ],
   "dependencies": {
+    "purescript-aff": "^6.0.0",
     "purescript-web-events": "^2.0.1",
     "purescript-web-html": "^2.3.0",
     "purescript-web-geometry": "https://github.com/keijokapp/purescript-web-geometry.git"

src/Web/CSSOMView/Screen.js

@@ -14,3 +14,4 @@ exports.width = getter("width");
 exports.height = getter("height");
 exports.colorDepth = getter("colorDepth");
 exports.pixelDepth = getter("pixelDepth");
+exports.orientation = getter("orientation");

src/Web/CSSOMView/Screen.purs

@@ -1,12 +1,14 @@
 module Web.CSSOMView.Screen where
 
 import Effect (Effect)
+import Web.CSSOMView.ScreenOrientation (ScreenOrientation)
 
 foreign import data Screen :: Type
 
-foreign import availWidth :: Effect Int
-foreign import availHeight :: Effect Int
-foreign import width :: Effect Int
-foreign import height :: Effect Int
-foreign import colorDepth :: Effect Int
-foreign import pixelDepth :: Effect Int
+foreign import availWidth :: Screen -> Effect Int
+foreign import availHeight :: Screen -> Effect Int
+foreign import width :: Screen -> Effect Int
+foreign import height :: Screen -> Effect Int
+foreign import colorDepth :: Screen -> Effect Int
+foreign import pixelDepth :: Screen -> Effect Int
+foreign import orientation :: Screen -> Effect ScreenOrientation

src/Web/CSSOMView/ScreenOrientation.js

@@ -0,0 +1,28 @@
+"use strict";
+
+exports.lockImpl = function lock(orientation) {
+  return function(so) {
+    return function(onError, onSuccess) {
+      so.lock(orientation).then(onSuccess, onError);
+      return function canceler(cancelError, onCancelerError, onCancelerSuccess) {
+        onCancelerSuccess();
+      };
+    };
+  };
+};
+
+exports.unlockImpl = function(so) {
+  return so.unlock();
+};
+
+exports.typeImpl = function(so) {
+  return so.type;
+};
+
+exports.angleImpl = function(so) {
+  return so.angle;
+};
+
+exports.onChangeImpl = function(handler, so) {
+  so.onchange = handler;
+};

src/Web/CSSOMView/ScreenOrientation.purs

@@ -0,0 +1,60 @@
+module Web.CSSOMView.ScreenOrientation
+  ( ScreenOrientation
+  , lock
+  , unlock
+  , type_
+  , angle
+  , onChange
+  , toEventTarget
+  , fromEventTarget
+  ) where
+
+-- https://w3c.github.io/screen-orientation/
+
+import Prelude
+
+import Data.Maybe (Maybe)
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
+import Effect.Uncurried (EffectFn1, EffectFn2, runEffectFn1, runEffectFn2)
+import Unsafe.Coerce (unsafeCoerce)
+import Web.CSSOMView.ScreenOrientation.OrientationLockType (OrientationLockType)
+import Web.CSSOMView.ScreenOrientation.OrientationLockType as OrientationLockType
+import Web.CSSOMView.ScreenOrientation.OrientationType (OrientationType)
+import Web.CSSOMView.ScreenOrientation.OrientationType as OrientationType
+import Web.Event.Internal.Types (Event, EventTarget)
+import Web.Internal.FFI (unsafeReadProtoTagged)
+
+foreign import data ScreenOrientation :: Type
+
+foreign import lockImpl :: String -> ScreenOrientation -> EffectFnAff Unit
+
+lock :: OrientationLockType -> ScreenOrientation -> Aff Unit
+lock lockType = fromEffectFnAff <<< lockImpl (OrientationLockType.print lockType)
+
+foreign import unlockImpl :: EffectFn1 ScreenOrientation Unit
+
+unlock ∷ ScreenOrientation -> Effect Unit
+unlock = runEffectFn1 unlockImpl
+
+foreign import typeImpl :: EffectFn1 ScreenOrientation String
+
+type_ :: ScreenOrientation -> Effect (Maybe OrientationType)
+type_ = map OrientationType.parse <<< runEffectFn1 typeImpl
+
+foreign import angleImpl :: EffectFn1 ScreenOrientation Int
+
+angle :: ScreenOrientation -> Effect Int
+angle = runEffectFn1 angleImpl
+
+foreign import onChangeImpl :: EffectFn2 (Event -> Effect Unit) ScreenOrientation Unit
+
+onChange :: (Event -> Effect Unit) -> ScreenOrientation -> Effect Unit
+onChange = runEffectFn2 onChangeImpl
+
+toEventTarget :: ScreenOrientation -> EventTarget
+toEventTarget = unsafeCoerce
+
+fromEventTarget :: EventTarget -> Maybe ScreenOrientation
+fromEventTarget = unsafeReadProtoTagged "ScreenOrientation"

src/Web/CSSOMView/ScreenOrientation/OrientationLockType.purs

@@ -0,0 +1,51 @@
+module Web.CSSOMView.ScreenOrientation.OrientationLockType where
+
+import Prelude
+
+import Data.Maybe (Maybe(..))
+
+data OrientationLockType
+  = Any
+  | Natural
+  | Landscape
+  | Portrait
+  | PortraitPrimary
+  | PortraitSecondary
+  | LandscapePrimary
+  | LandscapeSecondary
+
+derive instance eqOrientationLockType :: Eq OrientationLockType
+
+instance showOrientationLockType :: Show OrientationLockType where
+  show = case _ of
+    Any -> "Any"
+    Natural -> "Natural"
+    Landscape -> "Landscape"
+    Portrait -> "Portrait"
+    PortraitPrimary -> "PortraitPrimary"
+    PortraitSecondary -> "PortraitSecondary"
+    LandscapePrimary -> "LandscapePrimary"
+    LandscapeSecondary -> "LandscapeSecondary"
+
+parse :: String -> Maybe OrientationLockType
+parse = case _ of
+  "any" -> Just Any
+  "natural" -> Just Natural
+  "landscape" -> Just Landscape
+  "portrait" -> Just Portrait
+  "portrait-primary" -> Just PortraitPrimary
+  "portrait-secondary" -> Just PortraitSecondary
+  "landscape-primary" -> Just LandscapePrimary
+  "landscape-secondary" -> Just LandscapeSecondary
+  _ -> Nothing
+
+print :: OrientationLockType -> String
+print = case _ of
+  Any -> "any"
+  Natural -> "natural"
+  Landscape -> "landscape"
+  Portrait -> "portrait"
+  PortraitPrimary -> "portrait-primary"
+  PortraitSecondary -> "portrait-secondary"
+  LandscapePrimary -> "landscape-primary"
+  LandscapeSecondary -> "landscape-secondary"

src/Web/CSSOMView/ScreenOrientation/OrientationType.purs

@@ -0,0 +1,49 @@
+module Web.CSSOMView.ScreenOrientation.OrientationType where
+
+import Prelude
+
+import Data.Maybe (Maybe(..))
+
+data OrientationType
+  = PortraitPrimary
+  | PortraitSecondary
+  | LandscapePrimary
+  | LandscapeSecondary
+
+derive instance eqOrientationType :: Eq OrientationType
+
+instance showOrientationType :: Show OrientationType where
+  show = case _ of
+    PortraitPrimary -> "PortraitPrimary"
+    PortraitSecondary -> "PortraitSecondary"
+    LandscapePrimary -> "LandscapePrimary"
+    LandscapeSecondary -> "LandscapeSecondary"
+
+parse :: String -> Maybe OrientationType
+parse = case _ of
+  "portrait-primary" -> Just PortraitPrimary
+  "portrait-secondary" -> Just PortraitSecondary
+  "landscape-primary" -> Just LandscapePrimary
+  "landscape-secondary" -> Just LandscapeSecondary
+  _ -> Nothing
+
+print :: OrientationType -> String
+print = case _ of
+  PortraitPrimary -> "portrait-primary"
+  PortraitSecondary -> "portrait-secondary"
+  LandscapePrimary -> "landscape-primary"
+  LandscapeSecondary -> "landscape-secondary"
+
+isPortrait :: OrientationType -> Boolean
+isPortrait = case _ of
+  PortraitPrimary -> true
+  PortraitSecondary -> true
+  LandscapePrimary -> false
+  LandscapeSecondary -> false
+
+isLandscape :: OrientationType -> Boolean
+isLandscape = case _ of
+  PortraitPrimary -> false
+  PortraitSecondary -> false
+  LandscapePrimary -> true
+  LandscapeSecondary -> true