From 7a267fe595c95f6403c4ab46aca484cc23223586 Mon Sep 17 00:00:00 2001 From: Kari Pahula Date: Tue, 23 Sep 2025 21:57:58 +0300 Subject: [PATCH] Add Codensity instance for MonadJSM --- jsaddle/jsaddle.cabal | 1 + jsaddle/src/Language/Javascript/JSaddle/Types.hs | 6 ++++++ 2 files changed, 7 insertions(+) diff --git a/jsaddle/jsaddle.cabal b/jsaddle/jsaddle.cabal index 166d9f0f..7ad7ba07 100644 --- a/jsaddle/jsaddle.cabal +++ b/jsaddle/jsaddle.cabal @@ -117,6 +117,7 @@ library base64-bytestring >=1.0.0.1 && <1.3, bytestring >=0.10.6.0 && <0.13, exceptions >=0.8 && <0.11, + kan-extensions >= 5 && < 6, lens >=3.8.5 && <5.4, primitive >=0.6.1.0 && <0.10, text >=1.2.1.3 && <1.3 || >= 2.0 && < 2.2, diff --git a/jsaddle/src/Language/Javascript/JSaddle/Types.hs b/jsaddle/src/Language/Javascript/JSaddle/Types.hs index 9d30881e..8fc70dc7 100644 --- a/jsaddle/src/Language/Javascript/JSaddle/Types.hs +++ b/jsaddle/src/Language/Javascript/JSaddle/Types.hs @@ -97,6 +97,7 @@ import GHCJS.Prim.Internal (JSVal(..), JSValueRef) import Data.JSString.Internal.Type (JSString(..)) import Control.DeepSeq (NFData(..)) import Control.Monad.Catch (MonadThrow, MonadCatch(..), MonadMask(..)) +import Control.Monad.Codensity (Codensity(..)) import Control.Monad.Trans.Cont (ContT(..)) import Control.Monad.Trans.Except (ExceptT(..)) import Control.Monad.Trans.Identity (IdentityT(..)) @@ -117,10 +118,12 @@ import Data.Int (Int64) import Data.Set (Set) import Data.Text (Text) import Data.Time.Clock (UTCTime(..)) +import Data.Type.Equality (type (~~)) import Data.Typeable (Typeable) import Data.Coerce (coerce, Coercible) import Data.Aeson (defaultOptions, genericToEncoding, ToJSON(..), FromJSON(..), Value) +import GHC.Exts (TYPE) import GHC.Generics (Generic) import Control.Monad.IO.Unlift (MonadUnliftIO) import qualified Control.Monad.Fail as Fail @@ -316,6 +319,9 @@ instance (Monoid w, MonadJSM m) => MonadJSM (Strict.WriterT w m) where liftJSM' = lift . liftJSM' {-# INLINE liftJSM' #-} +instance (m ~~ m', MonadJSM m') => MonadJSM (Codensity (m :: k -> TYPE rep)) where + liftJSM' = lift . liftJSM' + instance MonadRef JSM where type Ref JSM = Ref IO newRef = liftIO . newRef