git.iko.soy/reflex
on develop help sign in
Add lifting instances to ProfiledM
217b136Jack Kelly
ChangeLog.md+1
compare with develop
unifiedsplit
@@ -2,6 +2,7 @@
2
2
3## Unreleased
3## Unreleased
4
4
5+* Add lifting instances for most classes to `Reflex.Profiled.Profiled`.
5* Class `MonadQuery t q m` now has a `Monad m` superclass constraint.
6* Class `MonadQuery t q m` now has a `Monad m` superclass constraint.
6* Rename class `MonadBehaviorWriter` -> `BehaviorWriter` for
7* Rename class `MonadBehaviorWriter` -> `BehaviorWriter` for
7 consistency with `EventWriter`/`DynamicWriter`.
8 consistency with `EventWriter`/`DynamicWriter`.
src/Reflex/Profiled.hs+53−1
@@ -26,6 +26,7 @@ import Control.Monad.Primitive
26import Control.Monad.Reader
26import Control.Monad.Reader
27import Control.Monad.Ref
27import Control.Monad.Ref
28import Control.Monad.State.Strict (StateT, execStateT, modify)
28import Control.Monad.State.Strict (StateT, execStateT, modify)
29+import Data.Bifunctor
29import Data.Coerce
30import Data.Coerce
30import Data.Dependent.Map (DMap, GCompare)
31import Data.Dependent.Map (DMap, GCompare)
31import Data.FastMutableIntMap
32import Data.FastMutableIntMap
@@ -42,12 +43,20 @@ import Foreign.Ptr
42import GHC.Foreign
43import GHC.Foreign
43import GHC.IO.Encoding
44import GHC.IO.Encoding
44import GHC.Stack
45import GHC.Stack
46+import Reflex.Adjustable.Class
47+import Reflex.BehaviorWriter.Class
45import Reflex.Class
48import Reflex.Class
49+import Reflex.DynamicWriter.Class
50+import Reflex.EventWriter.Class
46import Reflex.Host.Class
51import Reflex.Host.Class
52+import Reflex.NotReady.Class
47import Reflex.PerformEvent.Class
53import Reflex.PerformEvent.Class
54+import Reflex.PostBuild.Class
55+import Reflex.Query.Class
56+import Reflex.Requester.Class
57+import Reflex.TriggerEvent.Class
48
58
49import System.IO.Unsafe
59import System.IO.Unsafe
50−import Unsafe.Coerce
51
60
52data ProfiledTimeline t
61data ProfiledTimeline t
53
62
@@ -178,6 +187,16 @@ instance MonadHold t m => MonadHold (ProfiledTimeline t) (ProfiledM m) where
178instance MonadSample t m => MonadSample (ProfiledTimeline t) (ProfiledM m) where
187instance MonadSample t m => MonadSample (ProfiledTimeline t) (ProfiledM m) where
179 sample (Behavior_Profiled b) = ProfiledM $ sample b
188 sample (Behavior_Profiled b) = ProfiledM $ sample b
180
189
190+instance Adjustable t m => Adjustable (ProfiledTimeline t) (ProfiledM m) where
191+ runWithReplace a0 a' = (fmap . fmap) coerce . lift $
192+ runWithReplace (coerce a0) (coerce $ coerce <$> a')
193+ traverseIntMapWithKeyWithAdjust f dm0 dm' = (fmap . fmap) coerce . lift $
194+ traverseIntMapWithKeyWithAdjust (\k v -> coerce $ f k v) dm0 (coerce dm')
195+ traverseDMapWithKeyWithAdjust f dm0 dm' = (fmap . fmap) coerce . lift $
196+ traverseDMapWithKeyWithAdjust (\k v -> coerce $ f k v) dm0 (coerce dm')
197+ traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = (fmap . fmap) coerce . lift $
198+ traverseDMapWithKeyWithAdjustWithMove (\k v -> coerce $ f k v) dm0 (coerce dm')
199+
181instance MonadTrans ProfiledM where
200instance MonadTrans ProfiledM where
182 lift = ProfiledM
201 lift = ProfiledM
183
202
@@ -189,6 +208,39 @@ instance PerformEvent t m => PerformEvent (ProfiledTimeline t) (ProfiledM m) whe
189 performEvent_ = lift . performEvent_ . coerce
208 performEvent_ = lift . performEvent_ . coerce
190 performEvent = lift . fmap coerce . performEvent . coerce
209 performEvent = lift . fmap coerce . performEvent . coerce
191
210
211+instance TriggerEvent t m => TriggerEvent (ProfiledTimeline t) (ProfiledM m) where
212+ newTriggerEvent = first coerce <$> lift newTriggerEvent
213+ newTriggerEventWithOnComplete = first coerce <$> lift newTriggerEventWithOnComplete
214+ newEventWithLazyTriggerWithOnComplete f = coerce <$> lift (newEventWithLazyTriggerWithOnComplete f)
215+
216+instance PostBuild t m => PostBuild (ProfiledTimeline t) (ProfiledM m) where
217+ getPostBuild = coerce <$> lift getPostBuild
218+
219+instance NotReady t m => NotReady (ProfiledTimeline t) (ProfiledM m) where
220+ notReady = lift notReady
221+ notReadyUntil = lift . notReadyUntil . coerce
222+
223+instance BehaviorWriter t w m => BehaviorWriter (ProfiledTimeline t) w (ProfiledM m) where
224+ tellBehavior = lift . tellBehavior . coerce
225+
226+instance DynamicWriter t w m => DynamicWriter (ProfiledTimeline t) w (ProfiledM m) where
227+ tellDyn = lift . tellDyn . coerce
228+
229+instance EventWriter t w m => EventWriter (ProfiledTimeline t) w (ProfiledM m) where
230+ tellEvent = lift . tellEvent . coerce
231+
232+instance MonadQuery t q m => MonadQuery (ProfiledTimeline t) q (ProfiledM m) where
233+ tellQueryIncremental = lift . tellQueryIncremental . coerce
234+ askQueryResult = coerce <$> lift askQueryResult
235+ queryIncremental = fmap coerce . lift . queryIncremental . coerce
236+
237+instance Requester t m => Requester (ProfiledTimeline t) (ProfiledM m) where
238+ type Request (ProfiledM m) = Request m
239+ type Response (ProfiledM m) = Response m
240+
241+ requesting = fmap coerce . lift . requesting . coerce
242+ requesting_ = lift . requesting_ . coerce
243+
192instance MonadRef m => MonadRef (ProfiledM m) where
244instance MonadRef m => MonadRef (ProfiledM m) where
193 type Ref (ProfiledM m) = Ref m
245 type Ref (ProfiledM m) = Ref m
194 newRef = lift . newRef
246 newRef = lift . newRef