ab1cf23 · reflex · git.iko.soy

git.iko.soy/reflex

Merge branch 'develop' into ts-maybet-instances

commitab1cf230a70a67d5d1a78ca42c62d427d7cd2bc3 authorElliot Cameron <3noch@users.noreply.github.com> dateTue 31 Mar 2020, 10:59 (7 years ago) parent0559114 77e79c4

8 files changed+98−26

compare with develop

unifiedsplit

ChangeLog.md+8 README.md+8−2 src/Reflex/BehaviorWriter/Base.hs+3−3 src/Reflex/BehaviorWriter/Class.hs+11−5 src/Reflex/FastWeak.hs+10 src/Reflex/Profiled.hs+53−1 src/Reflex/Query/Class.hs+5−5 src/Reflex/Spider/Internal.hs−10

ChangeLog.md+8

@@ -1,5 +1,13 @@

11# Revision history for reflex

3+## Unreleased

5+* Add lifting instances for most classes to `Reflex.Profiled.Profiled`.

6+* Class `MonadQuery t q m` now has a `Monad m` superclass constraint.

7+* Rename class `MonadBehaviorWriter` -> `BehaviorWriter` for

8+ consistency with `EventWriter`/`DynamicWriter`.

9+* Introduce deprecated alias `MonadBehaviorWriter = BehaviorWriter`.

10+

311## 0.6.4.1

412

513* Fix a bug in the Reflex Profiled transformer where

README.md+8−2

@@ -21,5 +21,11 @@ A summary of Reflex functions is available in the [quick reference](Quickref.md)

2121

2222### Hacking

2323

24−Use the `./scripts/hack-on reflex` script in [Reflex Platform](https://github.com/reflex-frp/reflex-platform) to checkout the source code of `reflex` locally in `reflex-platform/reflex` directory.

25−Then do modifications to the source in place, and use the `./try-reflex` or `./scripts/work-on` scripts to create the shell to test your changes.

24+From the root of a [Reflex

25+Platform](https://github.com/reflex-frp/reflex-platform) checkout, run

26+`./scripts/hack-on haskell-overlays/reflex-packages/dep/reflex`. This

27+will check out the reflex source code into the

28+`haskell-overlays/reflex-packages/dep/reflex` directory. You can then

29+point that checkout at your fork, make changes, etc. Use the

30+`./try-reflex` or `./scripts/work-on` scripts to start a shell in

31+which you can test your changes.

src/Reflex/BehaviorWriter/Base.hs+3−3

@@ -1,6 +1,6 @@

11{-|

22Module: Reflex.BehaviorWriter.Base

3−Description: Implementation of MonadBehaviorWriter

3+Description: Implementation of BehaviorWriter

44-}

55{-# LANGUAGE CPP #-}

66{-# LANGUAGE FlexibleInstances #-}

@@ -46,7 +46,7 @@ import Reflex.Query.Class

4646import Reflex.Requester.Class

4747import Reflex.TriggerEvent.Class

4848

49−-- | A basic implementation of 'MonadBehaviorWriter'.

49+-- | A basic implementation of 'BehaviorWriter'.

5050newtype BehaviorWriterT t w m a = BehaviorWriterT { unBehaviorWriterT :: StateT [Behavior t w] m a }

5151 deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadAsyncException, MonadException) -- The list is kept in reverse order

5252

@@ -89,7 +89,7 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (BehaviorWri

8989 newEventWithTrigger = lift . newEventWithTrigger

9090 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f

9191

92−instance (Monad m, Monoid w, Reflex t) => MonadBehaviorWriter t w (BehaviorWriterT t w m) where

92+instance (Monad m, Monoid w, Reflex t) => BehaviorWriter t w (BehaviorWriterT t w m) where

9393 tellBehavior w = BehaviorWriterT $ modify (w :)

9494

9595instance MonadReader r m => MonadReader r (BehaviorWriterT t w m) where

src/Reflex/BehaviorWriter/Class.hs+11−5

@@ -1,8 +1,9 @@

11{-|

22Module: Reflex.BehaviorWriter.Class

3−Description: This module defines the 'MonadBehaviorWriter' class

3+Description: This module defines the 'BehaviorWriter' class

44-}

55{-# LANGUAGE CPP #-}

6+{-# LANGUAGE ConstraintKinds #-}

67{-# LANGUAGE FlexibleInstances #-}

78{-# LANGUAGE FunctionalDependencies #-}

89{-# LANGUAGE UndecidableInstances #-}

@@ -10,16 +11,21 @@ Description: This module defines the 'MonadBehaviorWriter' class

1011{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

1112#endif

1213module Reflex.BehaviorWriter.Class

13− ( MonadBehaviorWriter (..)

14+ ( MonadBehaviorWriter

15+ , BehaviorWriter(..)

1416 ) where

1517

1618import Control.Monad.Reader (ReaderT, lift)

1719import Reflex.Class (Behavior)

1820

19−-- | 'MonadBehaviorWriter' efficiently collects 'Behavior' values using 'tellBehavior'

21+{-# DEPRECATED MonadBehaviorWriter "Use 'BehaviorWriter' instead" #-}

22+-- | Type synonym for 'BehaviorWriter'

23+type MonadBehaviorWriter = BehaviorWriter

24+

25+-- | 'BehaviorWriter' efficiently collects 'Behavior' values using 'tellBehavior'

2026-- and combines them monoidally to provide a 'Behavior' result.

21−class (Monad m, Monoid w) => MonadBehaviorWriter t w m | m -> t w where

27+class (Monad m, Monoid w) => BehaviorWriter t w m | m -> t w where

2228 tellBehavior :: Behavior t w -> m ()

2329

24−instance MonadBehaviorWriter t w m => MonadBehaviorWriter t w (ReaderT r m) where

30+instance BehaviorWriter t w m => BehaviorWriter t w (ReaderT r m) where

2531 tellBehavior = lift . tellBehavior

src/Reflex/FastWeak.hs+10

@@ -151,6 +151,16 @@ getFastWeakTicket w = do

151151

152152-- | Create a 'FastWeakTicket' directly from a value, creating a 'FastWeak' in the process

153153-- which can be obtained with 'getFastWeakTicketValue'.

154+--

155+-- This function is marked NOINLINE so it is opaque to GHC.

156+-- If we do not do this, then GHC will sometimes fuse the constructor away

157+-- so any weak references that are attached to the ticket will have their

158+-- finalizer run. Using the opaque constructor, GHC does not see the

159+-- constructor application, so it behaves like an IORef and cannot be fused away.

160+--

161+-- The result is also evaluated to WHNF, since forcing a thunk invalidates

162+-- the weak pointer to it in some cases.

163+{-# NOINLINE mkFastWeakTicket #-}

154164mkFastWeakTicket :: a -> IO (FastWeakTicket a)

155165-- 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

156166-- associated FastWeak to actually be weak

src/Reflex/Profiled.hs+53−1

@@ -26,6 +26,7 @@ import Control.Monad.Primitive

2626import Control.Monad.Reader

2727import Control.Monad.Ref

2828import Control.Monad.State.Strict (StateT, execStateT, modify)

29+import Data.Bifunctor

2930import Data.Coerce

3031import Data.Dependent.Map (DMap, GCompare)

3132import Data.FastMutableIntMap

@@ -42,12 +43,20 @@ import Foreign.Ptr

4243import GHC.Foreign

4344import GHC.IO.Encoding

4445import GHC.Stack

46+import Reflex.Adjustable.Class

47+import Reflex.BehaviorWriter.Class

4548import Reflex.Class

49+import Reflex.DynamicWriter.Class

50+import Reflex.EventWriter.Class

4651import Reflex.Host.Class

52+import Reflex.NotReady.Class

4753import Reflex.PerformEvent.Class

54+import Reflex.PostBuild.Class

55+import Reflex.Query.Class

56+import Reflex.Requester.Class

57+import Reflex.TriggerEvent.Class

4858

4959import System.IO.Unsafe

50−import Unsafe.Coerce

5160

5261data ProfiledTimeline t

5362

@@ -178,6 +187,16 @@ instance MonadHold t m => MonadHold (ProfiledTimeline t) (ProfiledM m) where

178187instance MonadSample t m => MonadSample (ProfiledTimeline t) (ProfiledM m) where

179188 sample (Behavior_Profiled b) = ProfiledM $ sample b

180189

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+

181200instance MonadTrans ProfiledM where

182201 lift = ProfiledM

183202

@@ -189,6 +208,39 @@ instance PerformEvent t m => PerformEvent (ProfiledTimeline t) (ProfiledM m) whe

189208 performEvent_ = lift . performEvent_ . coerce

190209 performEvent = lift . fmap coerce . performEvent . coerce

191210

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+

192244instance MonadRef m => MonadRef (ProfiledM m) where

193245 type Ref (ProfiledM m) = Ref m

194246 newRef = lift . newRef

src/Reflex/Query/Class.hs+5−5

@@ -125,7 +125,7 @@ instance Group SelectedCount where

125125

126126instance Additive SelectedCount

127127

128−-- | The Semigroup/Monoid/Group instances for a Query containing 'SelectedCount's should use

128+-- | The Semigroup\/Monoid\/Group instances for a Query containing 'SelectedCount's should use

129129-- this function which returns Nothing if the result is 0. This allows the pruning of leaves

130130-- of the 'Query' that are no longer wanted.

131131combineSelectedCounts :: SelectedCount -> SelectedCount -> Maybe SelectedCount

@@ -133,12 +133,12 @@ combineSelectedCounts (SelectedCount i) (SelectedCount j) = if i == negate j the

133133

134134-- | A class that allows sending of 'Query's and retrieval of 'QueryResult's. See 'queryDyn' for a commonly

135135-- used interface.

136−class (Group q, Additive q, Query q) => MonadQuery t q m | m -> q t where

136+class (Group q, Additive q, Query q, Monad m) => MonadQuery t q m | m -> q t where

137137 tellQueryIncremental :: Incremental t (AdditivePatch q) -> m ()

138138 askQueryResult :: m (Dynamic t (QueryResult q))

139139 queryIncremental :: Incremental t (AdditivePatch q) -> m (Dynamic t (QueryResult q))

140140

141−instance (Monad m, MonadQuery t q m) => MonadQuery t q (ReaderT r m) where

141+instance MonadQuery t q m => MonadQuery t q (ReaderT r m) where

142142 tellQueryIncremental = lift . tellQueryIncremental

143143 askQueryResult = lift askQueryResult

144144 queryIncremental = lift . queryIncremental

@@ -148,11 +148,11 @@ tellQueryDyn :: (Reflex t, MonadQuery t q m) => Dynamic t q -> m ()

148148tellQueryDyn d = tellQueryIncremental $ unsafeBuildIncremental (sample (current d)) $ attachWith (\old new -> AdditivePatch $ new ~~ old) (current d) (updated d)

149149

150150-- | Retrieve 'Dynamic'ally updating 'QueryResult's for a 'Dynamic'ally updating 'Query'.

151−queryDyn :: (Reflex t, Monad m, MonadQuery t q m) => Dynamic t q -> m (Dynamic t (QueryResult q))

151+queryDyn :: (Reflex t, MonadQuery t q m) => Dynamic t q -> m (Dynamic t (QueryResult q))

152152queryDyn q = do

153153 tellQueryDyn q

154154 zipDynWith crop q <$> askQueryResult

155155

156156-- | Use a query morphism to operate on a smaller version of a query.

157−subQuery :: (Reflex t, MonadQuery t q2 m, Monad m) => QueryMorphism q1 q2 -> Dynamic t q1 -> m (Dynamic t (QueryResult q1))

157+subQuery :: (Reflex t, MonadQuery t q2 m) => QueryMorphism q1 q2 -> Dynamic t q1 -> m (Dynamic t (QueryResult q1))

158158subQuery (QueryMorphism f g) x = fmap g <$> queryDyn (fmap f x)

src/Reflex/Spider/Internal.hs−10

@@ -450,16 +450,6 @@ data Subscriber x a = Subscriber

450450 , subscriberRecalculateHeight :: !(Height -> IO ())

451451 }

452452

453−--TODO: Move this comment to WeakBag

454−-- These function are constructor functions that are marked NOINLINE so they are

455−-- opaque to GHC. If we do not do this, then GHC will sometimes fuse the constructor away

456−-- so any weak references that are attached to the constructors will have their

457−-- finalizer run. Using the opaque constructor, does not see the

458−-- constructor application, so it behaves like an IORef and cannot be fused away.

459−--

460−-- The result is also evaluated to WHNF, since forcing a thunk invalidates

461−-- the weak pointer to it in some cases.

462−

463453newSubscriberHold :: (HasSpiderTimeline x, Patch p) => Hold x p -> IO (Subscriber x p)

464454newSubscriberHold h = return $ Subscriber

465455 { subscriberPropagate = {-# SCC "traverseHold" #-} propagateSubscriberHold h