-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Exception
-- 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.Exception
  ( -- ** Types
    MisoException (..)
    -- ** Functions
  , exception
  ) where
----------------------------------------------------------------------------
import           Control.Exception
import           Language.Javascript.JSaddle
----------------------------------------------------------------------------
import           Miso.String (MisoString, ms)
import qualified Miso.FFI as FFI
----------------------------------------------------------------------------
-- | The @MisoException@ type is used to catch @Component@-related mounting errors.
--
-- The two mounting errors that can occur during the lifetime of a miso application are
--
-- * Not Mounted Exception
--
-- This occurs if a user tries to call @sample myComponent@ when @myComponent@ is currently
-- not mounted on the DOM.
--
-- * Already Mounted Exception
--
-- It is a requirement that all @Component@ be named uniquely
-- (this is to avoid runaway recursion during mounting).
-- If we detect a @Component@ is attempting to be mounted twice
-- this exception will be raised.
--
-- Other exceptions can arise, but its up to the user to handle them in
-- the @update@ function. All unhandled exceptions are caught in the event loop
-- and logged to the console with /console.error()/
--
data MisoException
  = NotMountedException MisoString
  -- ^ Thrown when a @Component@ is sampled, yet not mounted.
  | AlreadyMountedException MisoString
  -- ^ Thrown when a @Component@ is attempted to be mounted twice.
  deriving (Int -> MisoException -> ShowS
[MisoException] -> ShowS
MisoException -> String
(Int -> MisoException -> ShowS)
-> (MisoException -> String)
-> ([MisoException] -> ShowS)
-> Show MisoException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MisoException -> ShowS
showsPrec :: Int -> MisoException -> ShowS
$cshow :: MisoException -> String
show :: MisoException -> String
$cshowList :: [MisoException] -> ShowS
showList :: [MisoException] -> ShowS
Show, MisoException -> MisoException -> Bool
(MisoException -> MisoException -> Bool)
-> (MisoException -> MisoException -> Bool) -> Eq MisoException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MisoException -> MisoException -> Bool
== :: MisoException -> MisoException -> Bool
$c/= :: MisoException -> MisoException -> Bool
/= :: MisoException -> MisoException -> Bool
Eq)
----------------------------------------------------------------------------
instance Exception MisoException
----------------------------------------------------------------------------
-- | Exception handler
--
-- Used to catch @Component@ mounting exceptions
--
-- > action `catch` exception
exception :: SomeException -> JSM JSVal
exception :: SomeException -> JSM JSVal
exception SomeException
ex
  | Just (NotMountedException MisoString
name) <- SomeException -> Maybe MisoException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex = do
      MisoString -> JSM ()
FFI.consoleError
        (MisoString
"NotMountedException: Could not sample model state from the Component \"" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
name MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"\"")
      JSVal -> JSM JSVal
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
jsNull
  | Just (AlreadyMountedException MisoString
name) <- SomeException -> Maybe MisoException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex = do
      MisoString -> JSM ()
FFI.consoleError (MisoString
"AlreadyMountedException: Component \"" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
name MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"\" is already")
      JSVal -> JSM JSVal
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
jsNull
  | Bool
otherwise = do
      MisoString -> JSM ()
FFI.consoleError (MisoString
"UnknownException: " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> SomeException -> MisoString
forall str. ToMisoString str => str -> MisoString
ms SomeException
ex)
      JSVal -> JSM JSVal
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
jsNull
----------------------------------------------------------------------------