git.iko.soy/reflex
on ae@dev-script help sign in
reflex/src/Reflex/FastWeak.hs
200 lines 7.1 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
9-- |
10-- Module:
11-- Reflex.FastWeak
12-- Description:
13-- 'FastWeak' is a weak pointer to some value, and 'FastWeakTicket' ensures the value
14-- referred to by a 'FastWeak' stays live while the ticket is held (live).
15--
16-- On GHC or GHCJS when not built with the @fast-weak@ cabal flag, 'FastWeak' is a wrapper
17-- around the simple version of 'System.Mem.Weak.Weak' where the key and value are the same.
18--
19-- On GHCJS when built with the @fast-weak@ cabal flag, 'FastWeak' is implemented directly
20-- in JS using @h$FastWeak@ and @h$FastWeakTicket@ which are a nonstandard part of the GHCJS RTS.
21module Reflex.FastWeak
22 ( FastWeakTicket
23 , FastWeak
24 , mkFastWeakTicket
25 , getFastWeakTicketValue
26 , getFastWeakTicketWeak
27 , getFastWeakValue
28 , getFastWeakTicket
29 , emptyFastWeak
30#ifdef GHCJS_FAST_WEAK
31 --TODO: Move these elsewhere
32 , unsafeFromRawJSVal
33 , unsafeToRawJSVal
34 , js_isNull
35#endif
36 ) where
38import GHC.Exts (Any)
39import Unsafe.Coerce
41#ifdef GHCJS_FAST_WEAK
42import GHCJS.Types
43#else
44import Control.Exception (evaluate)
45import System.IO.Unsafe
46import System.Mem.Weak
47#endif
50#ifdef GHCJS_FAST_WEAK
51-- | A 'FastWeak' which has been promoted to a strong reference. 'getFastWeakTicketValue'
52-- can be used to get the referred to value without fear of @Nothing,
53-- and 'getFastWeakTicketWeak' can be used to get the weak version.
54--
55-- Implemented by way of special support in the GHCJS RTS, @h$FastWeakTicket@.
56newtype FastWeakTicket a = FastWeakTicket JSVal
58-- | A reference to some value which can be garbage collected if there are only
59-- weak references to the value left.
60--
61-- 'getFastWeakValue' can be used to try and obtain a strong reference to the value.
62--
63-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using
64-- 'getFastWeakTicket' if the value hasn't been collected yet.
65--
66-- Implemented by way of special support in the GHCJS RTS, @h$FastWeak@.
67newtype FastWeak a = FastWeak JSVal
69-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two
70data Val a = Val { unVal :: a }
72-- | Coerce a JSVal that represents the heap object of a value of type @a@ into a value of type @a@
73unsafeFromRawJSVal :: JSVal -> a
74unsafeFromRawJSVal v = unVal (unsafeCoerce v)
76-- | Coerce a heap object of type @a@ into a 'JSVal' which represents that object.
77unsafeToRawJSVal :: a -> JSVal
78unsafeToRawJSVal v = unsafeCoerce (Val v)
79#else
80-- | A 'FastWeak' which has been promoted to a strong reference. 'getFastWeakTicketValue'
81-- can be used to get the referred to value without fear of @Nothing@,
82-- and 'getFastWeakTicketWeak' can be used to get the weak version.
83data FastWeakTicket a = FastWeakTicket
84 { _fastWeakTicket_val :: !a
85 , _fastWeakTicket_weak :: {-# UNPACK #-} !(Weak a)
86 }
88-- | A reference to some value which can be garbage collected if there are only weak references to the value left.
89--
90-- 'getFastWeakValue' can be used to try and obtain a strong reference to the value.
91--
92-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using 'getFastWeakTicket'
93-- if the value hasn't been collected yet.
94--
95-- Synonymous with 'Weak'.
96type FastWeak a = Weak a
97#endif
99-- | Return the @a@ kept alive by the given 'FastWeakTicket'.
100--
101-- This needs to be in IO so we know that we've relinquished the ticket.
102getFastWeakTicketValue :: FastWeakTicket a -> IO a
103#ifdef GHCJS_FAST_WEAK
104getFastWeakTicketValue t = do
105 v <- js_ticketVal t
106 return $ unsafeFromRawJSVal v
108foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a -> IO JSVal
109#else
110getFastWeakTicketValue = return . _fastWeakTicket_val
111#endif
113-- | Get the value referred to by a 'FastWeak' if it hasn't yet been collected,
114-- or @Nothing@ if it has been collected.
115getFastWeakValue :: FastWeak a -> IO (Maybe a)
116#ifdef GHCJS_FAST_WEAK
117getFastWeakValue w = do
118 r <- js_weakVal w
119 case js_isNull r of
120 True -> return Nothing
121 False -> return $ Just $ unsafeFromRawJSVal r
123foreign import javascript unsafe "$1 === null" js_isNull :: JSVal -> Bool
125foreign import javascript unsafe "$r = ($1.ticket === null) ? null : $1.ticket.val;" js_weakVal :: FastWeak a -> IO JSVal
126#else
127getFastWeakValue = deRefWeak
128#endif
130-- | Try to create a 'FastWeakTicket' for the given 'FastWeak' which will ensure the value referred
131-- remains alive. Returns @Just@ if the value hasn't been collected
132-- and a ticket can therefore be obtained, @Nothing@ if it's been collected.
133getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))
134#ifdef GHCJS_FAST_WEAK
135getFastWeakTicket w = do
136 r <- js_weakTicket w
137 case js_isNull r of
138 True -> return Nothing
139 False -> return $ Just $ FastWeakTicket r
141foreign import javascript unsafe "$r = $1.ticket;" js_weakTicket :: FastWeak a -> IO JSVal
142#else
143getFastWeakTicket w = do
144 deRefWeak w >>= \case
145 Nothing -> return Nothing
146 Just v -> return $ Just $ FastWeakTicket
147 { _fastWeakTicket_val = v
148 , _fastWeakTicket_weak = w
149 }
150#endif
152-- | Create a 'FastWeakTicket' directly from a value, creating a 'FastWeak' in the process
153-- which can be obtained with 'getFastWeakTicketValue'.
154mkFastWeakTicket :: a -> IO (FastWeakTicket a)
155-- 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
156-- associated FastWeak to actually be weak
157#ifdef GHCJS_FAST_WEAK
158mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)
160foreign import javascript unsafe "$r = new h$FastWeakTicket($1);" js_fastWeakTicket :: JSVal -> IO (FastWeakTicket a)
161#else
162mkFastWeakTicket v = do
163 v' <- evaluate v
164 w <- mkWeakPtr v' Nothing
165 return $ FastWeakTicket
166 { _fastWeakTicket_val = v'
167 , _fastWeakTicket_weak = w
168 }
169#endif
171-- | Demote a 'FastWeakTicket'; which ensures the value is alive, to a 'FastWeak' which doesn't.
172-- Note that unless the ticket for the same 'FastWeak' is held in some other way
173-- the value might be collected immediately.
174getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
175-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value
176#ifdef GHCJS_FAST_WEAK
177foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak' :: FastWeakTicket a -> IO (FastWeak a)
178{-# INLINE getFastWeakTicketWeak #-}
179getFastWeakTicketWeak = getFastWeakTicketWeak'
180#else
181getFastWeakTicketWeak = return . _fastWeakTicket_weak
182#endif
184-- | A weak reference that is always empty
185emptyFastWeak :: FastWeak a
186emptyFastWeak = unsafeCoerce w
187 where w :: FastWeak Any
188#ifdef GHCJS_FAST_WEAK
189 w = js_emptyWeak
190#else
191 w = unsafePerformIO $ do
192 w' <- mkWeakPtr undefined Nothing
193 finalize w'
194 return w'
195#endif
196{-# NOINLINE emptyFastWeak #-}
198#ifdef GHCJS_FAST_WEAK
199foreign import javascript unsafe "$r = new h$FastWeak(null);" js_emptyWeak :: FastWeak Any
200#endif