on master help sign in
Merge pull request #43 from bitonic/unliftio

add `MonadUnliftIO` instance for `JSM`

commit075d1a0e0d6d59d01b9c3bf57c01b4d5572c6c79 authorHamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> dateWed 29 Nov 2017, 17:07 (9 years ago) parent50895de5b3f923
3 files changed+8−4
jsaddle/default.nix+3−2 jsaddle/jsaddle.cabal+2−1 jsaddle/src/Language/Javascript/JSaddle/Types.hs+3−1
jsaddle/default.nix+3−2
@@ -1,7 +1,8 @@
11{ mkDerivation, aeson, attoparsec, base, base64-bytestring
22, bytestring, containers, deepseq, filepath, ghc-prim, http-types
33, lens, primitive, process, random, ref-tf, scientific, stdenv, stm
4−, text, time, transformers, unordered-containers, vector
4+, text, time, transformers, unordered-containers, unliftio-core
5+, vector
56}:
67mkDerivation {
78 pname = "jsaddle";
@@ -11,7 +12,7 @@ mkDerivation {
1112 aeson attoparsec base base64-bytestring bytestring containers
1213 deepseq filepath ghc-prim http-types lens primitive process random
1314 ref-tf scientific stm text time transformers unordered-containers
14− vector
15+ unliftio-core vector
1516 ];
1617 description = "Interface for JavaScript that works with GHCJS and GHC";
1718 license = stdenv.lib.licenses.mit;
jsaddle/jsaddle.cabal+2−1
@@ -48,7 +48,8 @@ library
4848 stm >=2.4.4 && <2.5,
4949 time >=1.5.0.1 && <1.9,
5050 unordered-containers >=0.2 && <0.3,
51− vector >=0.10 && <0.13
51+ vector >=0.10 && <0.13,
52+ unliftio-core >=0.1 && < 0.2
5253 exposed-modules:
5354 Data.JSString
5455 Data.JSString.Internal
jsaddle/src/Language/Javascript/JSaddle/Types.hs+3−1
@@ -123,6 +123,7 @@ import Data.Coerce (coerce, Coercible)
123123import Data.Aeson
124124 (defaultOptions, genericToEncoding, ToJSON(..), FromJSON(..), Value)
125125import GHC.Generics (Generic)
126+import Control.Monad.IO.Unlift (MonadUnliftIO)
126127#endif
127128
128129#if MIN_VERSION_base(4,9,0) && defined(CHECK_UNCHECKED)
@@ -164,7 +165,7 @@ data JSContextRef = JSContextRef {
164165type JSM = IO
165166#else
166167newtype JSM a = JSM { unJSM :: ReaderT JSContextRef IO a }
167− deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadThrow)
168+ deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadThrow, MonadUnliftIO)
168169
169170instance MonadCatch JSM where
170171 t `catch` c = JSM (unJSM (syncAfter t) `catch` \e -> unJSM (c e))
@@ -177,6 +178,7 @@ instance MonadMask JSM where
177178 JSM $ uninterruptibleMask $ \unmask -> unJSM (a $ q unmask)
178179 where q :: (ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a) -> JSM a -> JSM a
179180 q unmask (JSM b) = syncAfter . JSM $ unmask b
181+
180182#endif
181183
182184-- | Forces execution of pending asyncronous code