-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.FFI.History
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- 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
  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
=<< String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"window" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"location" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"href"
  case join href of
    Maybe MisoString
Nothing -> MisoString -> JSM MisoString
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MisoString
forall a. Monoid a => a
mempty
    Just MisoString
uri -> MisoString -> JSM MisoString
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MisoString
uri
-----------------------------------------------------------------------------
getHistory :: JSM JSVal
getHistory :: JSM JSVal
getHistory = String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"window" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"history"
-----------------------------------------------------------------------------
go :: Int -> JSM ()
go :: Int -> JSM ()
go Int
i = do
  _ <- JSM JSVal
getHistory JSM JSVal -> String -> [Int] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"go" ([Int] -> JSM JSVal) -> [Int] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Int
i]
  pure ()
-----------------------------------------------------------------------------
back :: JSM ()
back :: JSM ()
back = do
  _ <- JSM JSVal
getHistory JSM JSVal -> String -> () -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"back" (() -> JSM JSVal) -> () -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ()
  pure ()
-----------------------------------------------------------------------------
forward :: JSM ()
forward :: JSM ()
forward = do
  _ <- JSM JSVal
getHistory JSM JSVal -> String -> () -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"forward" (() -> JSM JSVal) -> () -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ()
  pure ()
-----------------------------------------------------------------------------
pushState :: MisoString -> JSM ()
pushState :: MisoString -> JSM ()
pushState MisoString
url = do
  _ <- JSM JSVal
getHistory JSM JSVal -> String -> (JSVal, JSVal, MisoString) -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"pushState" ((JSVal, JSVal, MisoString) -> JSM JSVal)
-> (JSVal, JSVal, MisoString) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (JSVal
jsNull, JSVal
jsNull, MisoString
url)
  pure ()
-----------------------------------------------------------------------------
replaceState :: MisoString -> JSM ()
replaceState :: MisoString -> JSM ()
replaceState MisoString
url = do
  _ <- JSM JSVal
getHistory JSM JSVal -> String -> (JSVal, JSVal, MisoString) -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"replaceState" ((JSVal, JSVal, MisoString) -> JSM JSVal)
-> (JSVal, JSVal, MisoString) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (JSVal
jsNull, JSVal
jsNull, MisoString
url)
  pure ()
-----------------------------------------------------------------------------