Implement missing History API (#87)

* Implement missing History API

* update CHANGELOG.md

Author: acple

CHANGELOG.md

@@ -7,6 +7,7 @@ Notable changes to this project are documented in this file. The format is based
 Breaking changes:
 
 New features:
+- Added `length`, `scrollRestoration` and `setScrollRestoration` for `History` (#87 by @acple)
 
 Bugfixes:
 

src/Web/HTML/History.js

@@ -47,3 +47,23 @@ export function state(history) {
     return history.state;
   };
 }
+
+export function length(history) {
+  return function() {
+    return history.length;
+  };
+}
+
+export function _scrollRestoration(history) {
+  return function() {
+    return history.scrollRestoration;
+  };
+}
+
+export function _setScrollRestoration(scrollRestoration) {
+  return function(history) {
+    return function() {
+      history.scrollRestoration = scrollRestoration;
+    };
+  };
+}

src/Web/HTML/History.purs

@@ -1,9 +1,26 @@
-module Web.HTML.History where
-
+module Web.HTML.History
+  ( History
+  , DocumentTitle(..)
+  , Delta(..)
+  , URL(..)
+  , back
+  , forward
+  , go
+  , pushState
+  , replaceState
+  , state
+  , length
+  , scrollRestoration
+  , setScrollRestoration
+  ) where
+
+import Prelude
+
+import Data.Maybe (fromMaybe)
 import Data.Newtype (class Newtype)
 import Effect (Effect)
 import Foreign (Foreign)
-import Prelude (class Eq, class Ord, Unit)
+import Web.HTML.ScrollRestoration (ScrollRestoration(..), parse, print)
 
 foreign import data History :: Type
 
@@ -32,3 +49,13 @@ foreign import go :: Delta -> History -> Effect Unit
 foreign import pushState :: Foreign -> DocumentTitle -> URL -> History -> Effect Unit
 foreign import replaceState :: Foreign -> DocumentTitle -> URL -> History -> Effect Unit
 foreign import state :: History -> Effect Foreign
+foreign import length :: History -> Effect Int
+
+foreign import _scrollRestoration :: History -> Effect String
+foreign import _setScrollRestoration :: String -> History -> Effect Unit
+
+scrollRestoration :: History -> Effect ScrollRestoration
+scrollRestoration = map (fromMaybe Auto <<< parse) <<< _scrollRestoration
+
+setScrollRestoration :: ScrollRestoration -> History -> Effect Unit
+setScrollRestoration = _setScrollRestoration <<< print

src/Web/HTML/ScrollRestoration.purs

@@ -0,0 +1,28 @@
+module Web.HTML.ScrollRestoration where
+
+import Prelude
+
+import Data.Maybe (Maybe(..))
+
+data ScrollRestoration
+  = Auto
+  | Manual
+
+derive instance eqScrollRestoration :: Eq ScrollRestoration
+derive instance ordScrollRestoration :: Ord ScrollRestoration
+
+instance showScrollRestoration :: Show ScrollRestoration where
+  show = case _ of
+    Auto -> "Auto"
+    Manual -> "Manual"
+
+parse :: String -> Maybe ScrollRestoration
+parse = case _ of
+  "auto" -> Just Auto
+  "manual" -> Just Manual
+  _ -> Nothing
+
+print :: ScrollRestoration -> String
+print = case _ of
+  Auto -> "auto"
+  Manual -> "manual"