-----------------------------------------------------------------------------
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings   #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Subscription.OnLine
-- 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.Subscription.OnLine
  ( -- *** Subscriptions
    onLineSub
  ) where
-----------------------------------------------------------------------------
import           Miso.Effect (Sub)
import           Miso.Subscription.Util (createSub)
import qualified Miso.FFI.Internal as FFI
-----------------------------------------------------------------------------
-- | Returns @Subscription@ for the navigator.onLine API.
--
-- <https://developer.mozilla.org/en-US/docs/Web/API/Navigator/onLine>
--
onLineSub :: (Bool -> action) -> Sub action
onLineSub :: forall action. (Bool -> action) -> Sub action
onLineSub Bool -> action
f Sink action
sink = JSM (Function, Function)
-> ((Function, Function) -> JSM ()) -> Sub action
forall a b action. JSM a -> (a -> JSM b) -> Sub action
createSub JSM (Function, Function)
acquire (Function, Function) -> JSM ()
release Sink action
sink
  where
    release :: (Function, Function) -> JSM ()
release (Function
cb1, Function
cb2) = do
      MisoString -> Function -> JSM ()
FFI.windowRemoveEventListener MisoString
"online" Function
cb1
      MisoString -> Function -> JSM ()
FFI.windowRemoveEventListener MisoString
"offline" Function
cb2
    acquire :: JSM (Function, Function)
acquire = do
      cb1 <- MisoString -> (JSVal -> JSM ()) -> JSM Function
FFI.windowAddEventListener MisoString
"online" (\JSVal
_ -> Sink action
sink (Bool -> action
f Bool
True))
      cb2 <- FFI.windowAddEventListener "offline" (\JSVal
_ -> Sink action
sink (Bool -> action
f Bool
False))
      pure (cb1, cb2)
-----------------------------------------------------------------------------