-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.FFI.History
-- Copyright   :  (C) 2016-2018 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
module Miso.FFI.History
  ( getWindowLocationHref
  , go
  , back
  , forward
  , pushState
  , replaceState
  ) where

import Control.Monad
import GHCJS.Types
import Language.Javascript.JSaddle
import Miso.String

getWindowLocationHref :: JSM MisoString
getWindowLocationHref :: JSM MisoString
getWindowLocationHref = do
  Maybe (Maybe MisoString)
href <- JSVal -> JSM (Maybe (Maybe MisoString))
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal (JSVal -> JSM (Maybe (Maybe MisoString)))
-> JSM JSVal -> JSM (Maybe (Maybe MisoString))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"window" JSM JSVal -> [Char] -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! [Char]
"location" JSM JSVal -> [Char] -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! [Char]
"href"
  case Maybe (Maybe MisoString) -> Maybe MisoString
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe MisoString)
href of
    Maybe MisoString
Nothing -> MisoString -> JSM MisoString
forall (f :: * -> *) a. Applicative f => a -> f a
pure MisoString
forall a. Monoid a => a
mempty
    Just MisoString
uri -> MisoString -> JSM MisoString
forall (f :: * -> *) a. Applicative f => a -> f a
pure MisoString
uri

getHistory :: JSM JSVal
getHistory :: JSM JSVal
getHistory = [Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"window" JSM JSVal -> [Char] -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! [Char]
"history"

go :: Int -> JSM ()
go :: Int -> JSM ()
go Int
i = do
  JSVal
_ <- JSM JSVal
getHistory JSM JSVal -> [Char] -> [Int] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# [Char]
"go" ([Int] -> JSM JSVal) -> [Int] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Int
i]
  () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

back :: JSM ()
back :: JSM ()
back = do
  JSVal
_ <- JSM JSVal
getHistory JSM JSVal -> [Char] -> () -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# [Char]
"back" (() -> JSM JSVal) -> () -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ()
  () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

forward :: JSM ()
forward :: JSM ()
forward = do
  JSVal
_ <- JSM JSVal
getHistory JSM JSVal -> [Char] -> () -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# [Char]
"forward" (() -> JSM JSVal) -> () -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ()
  () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

pushState :: MisoString -> JSM ()
pushState :: MisoString -> JSM ()
pushState MisoString
url = do
  JSVal
_ <- JSM JSVal
getHistory JSM JSVal -> [Char] -> (JSVal, JSVal, MisoString) -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# [Char]
"pushState" ((JSVal, JSVal, MisoString) -> JSM JSVal)
-> (JSVal, JSVal, MisoString) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (JSVal
jsNull, JSVal
jsNull, MisoString
url)
  () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

replaceState :: MisoString -> JSM ()
replaceState :: MisoString -> JSM ()
replaceState MisoString
url = do
  JSVal
_ <- JSM JSVal
getHistory JSM JSVal -> [Char] -> (JSVal, JSVal, MisoString) -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# [Char]
"replaceState" ((JSVal, JSVal, MisoString) -> JSM JSVal)
-> (JSVal, JSVal, MisoString) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (JSVal
jsNull, JSVal
jsNull, MisoString
url)
  () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()