git.iko.soy/patch
on 2d282dc help sign in
patch/src/Reflex/FastWeak.hs
146 lines 4.2 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4#if GHCJS_FAST_WEAK
5{-# LANGUAGE ForeignFunctionInterface #-}
6{-# LANGUAGE JavaScriptFFI #-}
7#endif
8module Reflex.FastWeak
9 ( FastWeakTicket
10 , FastWeak
11 , mkFastWeakTicket
12 , getFastWeakTicketValue
13 , getFastWeakTicketWeak
14 , getFastWeakValue
15 , getFastWeakTicket
16 , emptyFastWeak
17#ifdef GHCJS_FAST_WEAK
18 --TODO: Move these elsewhere
19 , unsafeFromRawJSVal
20 , unsafeToRawJSVal
21 , js_isNull
22#endif
23 ) where
25import GHC.Exts (Any)
26import Unsafe.Coerce
28#ifdef GHCJS_FAST_WEAK
29import GHCJS.Types
30#else
31import Control.Exception (evaluate)
32import System.IO.Unsafe
33import System.Mem.Weak
34#endif
37#ifdef GHCJS_FAST_WEAK
38newtype FastWeakTicket a = FastWeakTicket JSVal
40newtype FastWeak a = FastWeak JSVal
42-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two
43data Val a = Val { unVal :: a }
45-- | Coerce a JSVal that represents the heap object of a value of type 'a' into a value of type 'a'
46unsafeFromRawJSVal :: JSVal -> a
47unsafeFromRawJSVal v = unVal (unsafeCoerce v)
49unsafeToRawJSVal :: a -> JSVal
50unsafeToRawJSVal v = unsafeCoerce (Val v)
51#else
52data FastWeakTicket a = FastWeakTicket
53 { _fastWeakTicket_val :: !a
54 , _fastWeakTicket_weak :: {-# UNPACK #-} !(Weak a)
55 }
57type FastWeak a = Weak a
58#endif
60-- This needs to be in IO so we know that we've relinquished the ticket
61getFastWeakTicketValue :: FastWeakTicket a -> IO a
62#ifdef GHCJS_FAST_WEAK
63getFastWeakTicketValue t = do
64 v <- js_ticketVal t
65 return $ unsafeFromRawJSVal v
67foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a -> IO JSVal
68#else
69getFastWeakTicketValue = return . _fastWeakTicket_val
70#endif
72getFastWeakValue :: FastWeak a -> IO (Maybe a)
73#ifdef GHCJS_FAST_WEAK
74getFastWeakValue w = do
75 r <- js_weakVal w
76 case js_isNull r of
77 True -> return Nothing
78 False -> return $ Just $ unsafeFromRawJSVal r
80foreign import javascript unsafe "$1 === null" js_isNull :: JSVal -> Bool
82foreign import javascript unsafe "$r = ($1.ticket === null) ? null : $1.ticket.val;" js_weakVal :: FastWeak a -> IO JSVal
83#else
84getFastWeakValue = deRefWeak
85#endif
87getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))
88#ifdef GHCJS_FAST_WEAK
89getFastWeakTicket w = do
90 r <- js_weakTicket w
91 case js_isNull r of
92 True -> return Nothing
93 False -> return $ Just $ FastWeakTicket r
95foreign import javascript unsafe "$r = $1.ticket;" js_weakTicket :: FastWeak a -> IO JSVal
96#else
97getFastWeakTicket w = do
98 deRefWeak w >>= \case
99 Nothing -> return Nothing
100 Just v -> return $ Just $ FastWeakTicket
101 { _fastWeakTicket_val = v
102 , _fastWeakTicket_weak = w
103 }
104#endif
106-- I think it's fine if this is lazy - it'll retain the 'a', but so would the output; we just need to make sure it's forced before we start relying on the associated FastWeak to actually be weak
107mkFastWeakTicket :: a -> IO (FastWeakTicket a)
108#ifdef GHCJS_FAST_WEAK
109mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)
111foreign import javascript unsafe "$r = new h$FastWeakTicket($1);" js_fastWeakTicket :: JSVal -> IO (FastWeakTicket a)
112#else
113mkFastWeakTicket v = do
114 v' <- evaluate v
115 w <- mkWeakPtr v' Nothing
116 return $ FastWeakTicket
117 { _fastWeakTicket_val = v'
118 , _fastWeakTicket_weak = w
119 }
120#endif
122-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value
123#ifdef GHCJS_FAST_WEAK
124foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
125#else
126getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
127getFastWeakTicketWeak = return . _fastWeakTicket_weak
128#endif
130-- | A weak reference that is always empty
131emptyFastWeak :: FastWeak a
132emptyFastWeak = unsafeCoerce w
133 where w :: FastWeak Any
134#ifdef GHCJS_FAST_WEAK
135 w = js_emptyWeak
136#else
137 w = unsafePerformIO $ do
138 w' <- mkWeakPtr undefined Nothing
139 finalize w'
140 return w'
141#endif
142{-# NOINLINE emptyFastWeak #-}
144#ifdef GHCJS_FAST_WEAK
145foreign import javascript unsafe "$r = new h$FastWeak(null);" js_emptyWeak :: FastWeak Any
146#endif