packages feed

reflex 0.9.3.1 → 0.9.3.2

raw patch · 20 files changed

+43/−81 lines, 20 filesdep −proctestdep ~witherablenew-uploader

Dependencies removed: proctest

Dependency ranges changed: witherable

Files

ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for reflex +## 0.9.3.2++* Add support for witherable 0.5+ ## 0.9.3.1  * Add support for GHC 9.8 and 9.10
reflex.cabal view
@@ -1,5 +1,5 @@ Name: reflex-Version: 0.9.3.1+Version: 0.9.3.2 Synopsis: Higher-order Functional Reactive Programming Description:   Interactive programs without callbacks or side-effects.@@ -100,7 +100,7 @@     time >= 1.4 && < 1.13,     transformers >= 0.5 && < 0.7,     unbounded-delays >= 0.1.0.0 && < 0.2,-    witherable >= 0.4 && < 0.5+    witherable >= 0.4 && < 0.6    if flag(split-these)     build-depends:     these >= 1 && <1.3,@@ -258,6 +258,7 @@                , directory                , filepath                , filemanip+               , reflex   if impl(ghc >= 9.6)     buildable: False   if impl(ghc < 9.2)@@ -310,7 +311,6 @@                , reflex                , ref-tf                , witherable-               , proctest     if flag(split-these)
src/Control/Monad/ReaderIO.hs view
@@ -38,8 +38,6 @@   liftA2 = liftM2   {-# INLINE liftA2 #-} #endif-  (*>) = (>>)-  {-# INLINE (*>) #-}  instance Monad (ReaderIO e) where   ReaderIO q >>= f = ReaderIO $ \e -> q e >>= \a -> runReaderIO (f a) e
src/Data/AppendMap.hs view
@@ -30,9 +30,8 @@ #else import qualified Data.Map as Map (showTree, showTreeWith) #endif-import qualified Data.Witherable as W+ import Data.Map.Monoidal-import qualified Data.Map.Monoidal as MonoidalMap   {-# DEPRECATED AppendMap "Use 'MonoidalMap' instead" #-}@@ -47,11 +46,6 @@ -- | Pattern synonym for 'MonoidalMap' pattern AppendMap :: Map k v -> MonoidalMap k v pattern AppendMap m = MonoidalMap m--#if !MIN_VERSION_witherable(0,3,2)-instance W.Filterable (MonoidalMap k) where-  mapMaybe = MonoidalMap.mapMaybe-#endif  -- | Deletes a key, returning 'Nothing' if the result is empty. nonEmptyDelete :: Ord k => k -> MonoidalMap k a -> Maybe (MonoidalMap k a)
src/Reflex/Class.hs view
@@ -204,7 +204,6 @@ import Data.Functor.Compose import Data.Functor.Product import Data.GADT.Compare (GEq (..), GCompare (..))-import Data.FastMutableIntMap (PatchIntMap) import Data.Foldable import Data.Functor.Bind import Data.Functor.Misc@@ -220,12 +219,12 @@ import Data.These import Data.Type.Coercion import Data.Type.Equality ((:~:) (..))-import Data.Witherable (Filterable(..))-import qualified Data.Witherable as W import Reflex.FunctorMaybe (FunctorMaybe) import qualified Reflex.FunctorMaybe import Data.Patch import qualified Data.Patch.MapWithMove as PatchMapWithMove+import Witherable (Filterable(..))+import qualified Witherable as W  import Debug.Trace (trace) @@ -680,14 +679,17 @@ instance Reflex t => Monad (Behavior t) where   a >>= f = pull $ sample a >>= sample . f   -- Note: it is tempting to write (_ >> b = b); however, this would result in (fail x >> return y) succeeding (returning y), which violates the law that (a >> b = a >>= \_ -> b), since the implementation of (>>=) above actually will fail.  Since we can't examine 'Behavior's other than by using sample, I don't think it's possible to write (>>) to be more efficient than the (>>=) above.-  return = constant #if !MIN_VERSION_base(4,13,0)   fail = error "Monad (Behavior t) does not support fail" #endif +instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where+  a <> b = pull $ liftM2 (<>) (sample a) (sample b)+  sconcat = pull . fmap sconcat . mapM sample+  stimes n = fmap $ stimes n+ instance (Reflex t, Monoid a) => Monoid (Behavior t a) where   mempty = constant mempty-  mappend a b = pull $ liftM2 mappend (sample a) (sample b)   mconcat = pull . fmap mconcat . mapM sample  instance (Reflex t, Num a) => Num (Behavior t a) where@@ -708,11 +710,6 @@   negate = fmap negate   (-) = liftA2 (-) -instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where-  a <> b = pull $ liftM2 (<>) (sample a) (sample b)-  sconcat = pull . fmap sconcat . mapM sample-  stimes n = fmap $ stimes n- -- | Alias for 'mapMaybe' fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b fmapMaybe = mapMaybe@@ -1159,7 +1156,6 @@ instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where   mconcat = distributeListOverDynWith mconcat   mempty = constDyn mempty-  mappend = zipDynWith mappend  -- | This function converts a 'DMap' whose elements are 'Dynamic's into a -- 'Dynamic' 'DMap'.  Its implementation is more efficient than doing the same
src/Reflex/Dynamic.hs view
@@ -82,7 +82,6 @@ import Data.Functor.Misc import Reflex.Class -import Control.Monad import Control.Monad.Fix import Control.Monad.Identity import Data.Align@@ -91,11 +90,9 @@ import Data.Dependent.Sum (DSum (..)) import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..)) import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap import Data.Kind (Type) import Data.Map (Map) import Data.Maybe-import Data.Monoid ((<>)) import Data.These import Data.Type.Equality ((:~:) (..))
src/Reflex/Dynamic/TH.hs view
@@ -20,7 +20,6 @@ import Control.Monad.State import Data.Data import Data.Generics-import Data.Monoid ((<>)) import qualified Language.Haskell.Exts as Hs import qualified Language.Haskell.Meta.Syntax.Translate as Hs import Language.Haskell.TH
src/Reflex/Dynamic/Uniq.hs view
@@ -14,7 +14,6 @@   , alreadyUniqDynamic   ) where -import Control.Applicative (Applicative (..)) import GHC.Exts import Reflex.Class @@ -101,5 +100,3 @@  instance Reflex t => Monad (UniqDynamic t) where   UniqDynamic x >>= f = uniqDynamic $ x >>= unUniqDynamic . f-  _ >> b = b-  return = pure
src/Reflex/DynamicWriter/Base.hs view
@@ -39,7 +39,6 @@ import qualified Data.IntMap as IntMap import Data.Map (Map) import qualified Data.Map as Map-import Data.Semigroup (Semigroup(..)) import Data.Some (Some) import Data.These @@ -126,7 +125,7 @@  -- | Run a 'DynamicWriterT' action.  The dynamic writer output will be provided -- along with the result of the action.-runDynamicWriterT :: (MonadFix m, Reflex t, Monoid w) => DynamicWriterT t w m a -> m (a, Dynamic t w)+runDynamicWriterT :: (Monad m, Reflex t, Monoid w) => DynamicWriterT t w m a -> m (a, Dynamic t w) runDynamicWriterT (DynamicWriterT a) = do   (result, ws) <- runStateT a []   return (result, mconcat $ reverse ws)@@ -165,7 +164,7 @@ -- | When the execution of a 'DynamicWriterT' action is adjusted using -- 'Adjustable', the 'Dynamic' output of that action will also be updated to -- match.-instance (Adjustable t m, MonadFix m, Monoid w, MonadHold t m, Reflex t) => Adjustable t (DynamicWriterT t w m) where+instance (Adjustable t m, Monoid w, MonadHold t m, Reflex t) => Adjustable t (DynamicWriterT t w m) where   runWithReplace a0 a' = do     (result0, result') <- lift $ runWithReplace (runDynamicWriterT a0) $ runDynamicWriterT <$> a'     tellDyn . join =<< holdDyn (snd result0) (snd <$> result')@@ -174,7 +173,7 @@   traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjustImpl traverseDMapWithKeyWithAdjust mapPatchDMap weakenPatchDMapWith mergeDynIncremental   traverseDMapWithKeyWithAdjustWithMove = traverseDMapWithKeyWithAdjustImpl traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove weakenPatchDMapWithMoveWith mergeDynIncrementalWithMove -traverseDMapWithKeyWithAdjustImpl :: forall t w k v' p p' v m. (PatchTarget (p' (Some k) (Dynamic t w)) ~ Map (Some k) (Dynamic t w), PatchTarget (p' (Some k) w) ~ Map (Some k) w, Patch (p' (Some k) w), Patch (p' (Some k) (Dynamic t w)), MonadFix m, Monoid w, Reflex t, MonadHold t m)+traverseDMapWithKeyWithAdjustImpl :: forall t w k v' p p' v m. (PatchTarget (p' (Some k) (Dynamic t w)) ~ Map (Some k) (Dynamic t w), PatchTarget (p' (Some k) w) ~ Map (Some k) w, Patch (p' (Some k) w), Patch (p' (Some k) (Dynamic t w)), Monoid w, Reflex t, MonadHold t m)   => (   (forall a. k a -> v a -> m (DynamicWriterTLoweredResult t w v' a))       -> DMap k v       -> Event t (p k v)@@ -201,7 +200,7 @@   tellDyn $ fmap (mconcat . Map.elems) $ incrementalToDynamic $ mergeMyDynIncremental i   return (liftedResult0, liftedResult') -traverseIntMapWithKeyWithAdjustImpl :: forall t w v' p p' v m. (PatchTarget (p' (Dynamic t w)) ~ IntMap (Dynamic t w), PatchTarget (p' w) ~ IntMap w, Patch (p' w), Patch (p' (Dynamic t w)), MonadFix m, Monoid w, Reflex t, MonadHold t m, Functor p, p ~ p')+traverseIntMapWithKeyWithAdjustImpl :: forall t w v' p p' v m. (PatchTarget (p' (Dynamic t w)) ~ IntMap (Dynamic t w), PatchTarget (p' w) ~ IntMap w, Patch (p' w), Patch (p' (Dynamic t w)), Monoid w, Reflex t, MonadHold t m, Functor p, p ~ p')   => (   (IntMap.Key -> v -> m (v', Dynamic t w))       -> IntMap v       -> Event t (p v)@@ -225,7 +224,7 @@   return (liftedResult0, liftedResult')  -- | Map a function over the output of a 'DynamicWriterT'.-withDynamicWriterT :: (Monoid w, Monoid w', Reflex t, MonadHold t m, MonadFix m)+withDynamicWriterT :: (Monoid w, Monoid w', Reflex t, MonadHold t m)                    => (w -> w')                    -> DynamicWriterT t w m a                    -> DynamicWriterT t w' m a
src/Reflex/EventWriter/Class.hs view
@@ -11,7 +11,6 @@   ) where  import Control.Monad.Reader (ReaderT, lift)-import Data.Semigroup (Semigroup)  import Reflex.Class (Event)
src/Reflex/FunctorMaybe.hs view
@@ -19,7 +19,7 @@ #if !MIN_VERSION_base(4,16,0) import Data.Semigroup (Option(..)) #endif-import Data.Witherable+import Witherable  --TODO: See if there's a better class in the standard libraries already
src/Reflex/PostBuild/Base.hs view
@@ -70,7 +70,6 @@ -- TODO: Monoid and Semigroup can likely be derived once ReaderT has them. instance (Monoid a, Applicative m) => Monoid (PostBuildT t m a) where   mempty = pure mempty-  mappend = liftA2 mappend  instance (S.Semigroup a, Applicative m) => S.Semigroup (PostBuildT t m a) where   (<>) = liftA2 (S.<>)
src/Reflex/Profiled.hs view
@@ -36,7 +36,6 @@ import Data.Kind (Type) import Data.Map (Map) import qualified Data.Map.Strict as Map-import Data.Monoid ((<>)) import Data.Ord import Data.Profunctor.Unsafe ((#.)) import qualified Data.Semigroup as S
src/Reflex/Query/Base.hs view
@@ -41,7 +41,6 @@ import Data.Kind (Type) import Data.Map (Map) import qualified Data.Map as Map-import Data.Monoid ((<>)) import qualified Data.Semigroup as S import Data.Semigroup.Commutative import Data.Some (Some(Some))
src/Reflex/Query/Class.hs view
@@ -37,7 +37,6 @@ import Data.Kind (Type) import Data.Map.Monoidal (MonoidalMap) import qualified Data.Map.Monoidal as MonoidalMap-import Data.Semigroup (Semigroup(..)) import Data.Semigroup.Commutative import Data.Void import Data.Monoid hiding ((<>))
src/Reflex/Requester/Base/Internal.hs view
@@ -55,9 +55,7 @@ import Data.Kind (Type) import Data.Map (Map) import qualified Data.Map as Map-import Data.Monoid ((<>)) import Data.Proxy-import qualified Data.Semigroup as S import Data.Some (Some(Some)) import Data.Type.Equality import Data.Unique.Tag@@ -298,10 +296,9 @@ -- TODO: Monoid and Semigroup can likely be derived once StateT has them. instance (Monoid a, Monad m) => Monoid (RequesterT t request response m a) where   mempty = pure mempty-  mappend = liftA2 mappend -instance (S.Semigroup a, Monad m) => S.Semigroup (RequesterT t request response m a) where-  (<>) = liftA2 (S.<>)+instance (Semigroup a, Monad m) => Semigroup (RequesterT t request response m a) where+  (<>) = liftA2 (<>)   -- | Run a 'RequesterT' action.  The resulting 'Event' will fire whenever
src/Reflex/Spider/Internal.hs view
@@ -44,14 +44,16 @@ import Control.Monad.IO.Class import Control.Monad.ReaderIO import Control.Monad.Ref+#if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail (MonadFail)+#endif import qualified Control.Monad.Fail as MonadFail import Data.Align import Data.Coerce import Data.Dependent.Map (DMap) import qualified Data.Dependent.Map as DMap import Data.Dependent.Sum (DSum (..))-import Data.FastMutableIntMap (FastMutableIntMap, PatchIntMap (..))+import Data.FastMutableIntMap (FastMutableIntMap) import qualified Data.FastMutableIntMap as FastMutableIntMap import Data.Foldable hiding (concat, elem, sequence_) import Data.Functor.Constant@@ -63,12 +65,10 @@ import Data.IORef import Data.Kind (Type) import Data.Maybe hiding (mapMaybe)-import Data.Monoid (mempty, (<>)) import Data.Proxy import Data.These import Data.Traversable import Data.Type.Equality ((:~:)(Refl))-import Data.Witherable (Filterable, mapMaybe) import GHC.Exts hiding (toList) import GHC.IORef (IORef (..)) import GHC.Stack@@ -76,6 +76,7 @@ import System.IO.Unsafe import System.Mem.Weak import Unsafe.Coerce+import Witherable (Filterable, mapMaybe)  #ifdef MIN_VERSION_semialign #if MIN_VERSION_these(0,8,0)@@ -93,7 +94,10 @@ import Data.List.NonEmpty (NonEmpty (..), nonEmpty) import qualified Data.List.NonEmpty as NonEmpty import Data.Tree (Forest, Tree (..), drawForest)++#ifdef DEBUG_HIDE_INTERNALS import Data.List (isPrefixOf)+#endif  import Data.FastWeakBag (FastWeakBag, FastWeakBagTicket) import qualified Data.FastWeakBag as FastWeakBag@@ -253,7 +257,7 @@ -- caching; if the computation function is very cheap, this is (much) more -- efficient than 'push' {-# INLINE [1] pushCheap #-}-pushCheap :: HasSpiderTimeline x => (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b+pushCheap :: (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b pushCheap !f e = Event $ \sub -> do   (subscription, occ) <- subscribeAndRead e $ debugSubscriber' "push" $ sub     { subscriberPropagate = \a -> do@@ -274,7 +278,7 @@  -- | Subscribe to an Event only for the duration of one occurrence {-# INLINE subscribeAndReadHead #-}-subscribeAndReadHead :: HasSpiderTimeline x => Event x a -> Subscriber x a -> EventM x (EventSubscription x, Maybe a)+subscribeAndReadHead :: Event x a -> Subscriber x a -> EventM x (EventSubscription x, Maybe a) subscribeAndReadHead e sub = do   subscriptionRef <- liftIO $ newIORef $ error "subscribeAndReadHead: not initialized"   (subscription, occ) <- subscribeAndRead e $ debugSubscriber' "head" $ sub@@ -288,7 +292,7 @@   return (subscription, occ)  --TODO: Make this lazy in its input event-headE :: (MonadIO m, Defer (SomeMergeInit x) m, HasSpiderTimeline x) => Event x a -> m (Event x a)+headE :: (MonadIO m, Defer (SomeMergeInit x) m) => Event x a -> m (Event x a) headE originalE = do   parent <- liftIO $ newIORef $ Just originalE   defer $ SomeMergeInit $ do --TODO: Rename SomeMergeInit appropriately@@ -313,8 +317,7 @@ nowSpiderEventM =   SpiderEvent <$> now -now :: (MonadIO m, Defer (Some Clear) m, HasSpiderTimeline x-       ) => m (Event x ())+now :: (MonadIO m, Defer (Some Clear) m) => m (Event x ()) now = do   nowOrNot <- liftIO $ newIORef $ Just ()   scheduleClear nowOrNot@@ -553,14 +556,14 @@ recalculateSubscriberHeight = flip subscriberRecalculateHeight  -- | Propagate everything at the current height-propagate :: forall x a. HasSpiderTimeline x => a -> WeakBag (Subscriber x a) -> EventM x ()+propagate :: forall x a. a -> WeakBag (Subscriber x a) -> EventM x () propagate a subscribers = withIncreasedDepth (Proxy::Proxy x) $   -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them   --TODO: Should we check if nodes already have their values before propagating?  Maybe we're re-doing work   WeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a  -- | Propagate everything at the current height-propagateFast :: forall x a. HasSpiderTimeline x => a -> FastWeakBag (Subscriber x a) -> EventM x ()+propagateFast :: forall x a. a -> FastWeakBag (Subscriber x a) -> EventM x () propagateFast a subscribers = withIncreasedDepth (Proxy::Proxy x) $   -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them   --TODO: Should we check if nodes already have their values before propagating?  Maybe we're re-doing work@@ -992,10 +995,6 @@ instance Monad (BehaviorM x) where   {-# INLINE (>>=) #-}   BehaviorM x >>= f = BehaviorM $ x >>= unBehaviorM . f-  {-# INLINE (>>) #-}-  BehaviorM x >> BehaviorM y = BehaviorM $ x >> y-  {-# INLINE return #-}-  return x = BehaviorM $ return x #if !MIN_VERSION_base(4,13,0)   {-# INLINE fail #-}   fail s = BehaviorM $ fail s@@ -1096,7 +1095,7 @@     _ -> IntMap.insert h (pred old) c  heightBagRemoveMaybe :: Height -> HeightBag -> Maybe HeightBag-heightBagRemoveMaybe (Height h) b@(HeightBag s c) = heightBagVerify . removed <$> IntMap.lookup h c where+heightBagRemoveMaybe (Height h) (HeightBag s c) = heightBagVerify . removed <$> IntMap.lookup h c where   removed old = HeightBag (pred s) $ case old of     0 -> IntMap.delete h c     _ -> IntMap.insert h (pred old) c@@ -1473,7 +1472,7 @@ #ifdef DEBUG_HIDE_INTERNALS filterStack prefix = filter (not . (prefix `isPrefixOf`)) #else-filterStack prefix = id+filterStack _prefix = id #endif  #ifdef DEBUG_CYCLES@@ -2055,7 +2054,7 @@   --TODO: Assert that m is not empty   subscriberPropagate (_merge_sub m) vals -checkCycle :: HasSpiderTimeline x => EventSubscribed x -> EventM x ()+checkCycle :: EventSubscribed x -> EventM x () checkCycle subscribed = liftIO $ do     height <- readIORef (eventSubscribedHeightRef subscribed) @@ -2551,12 +2550,8 @@   instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where-  {-# INLINE return #-}-  return = pure   {-# INLINE (>>=) #-}   x >>= f = SpiderDynamic $ dynamicDynIdentity $ newJoinDyn $ newMapDyn (unSpiderDynamic . f) $ unSpiderDynamic x-  {-# INLINE (>>) #-}-  (>>) = (*>) #if !MIN_VERSION_base(4,13,0)   {-# INLINE fail #-}   fail _ = error "Dynamic does not support 'fail'"@@ -2614,8 +2609,8 @@   headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e   {-# INLINABLE now #-}   now = runFrame . runSpiderHostFrame $ Reflex.Class.now-   + instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where   sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can @@ -2837,15 +2832,12 @@   atomicModifyRef r f = liftIO $ atomicModifyRef r f  -- | The monad for actions that manipulate a Spider timeline identified by @x@-newtype SpiderHost (x :: Type) a = SpiderHost { unSpiderHost :: IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)+newtype SpiderHost (x :: Type) a = SpiderHost { unSpiderHost :: IO a }+  deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)  instance Monad (SpiderHost x) where   {-# INLINABLE (>>=) #-}   SpiderHost x >>= f = SpiderHost $ x >>= unSpiderHost . f-  {-# INLINABLE (>>) #-}-  SpiderHost x >> SpiderHost y = SpiderHost $ x >> y-  {-# INLINABLE return #-}-  return x = SpiderHost $ return x #if !MIN_VERSION_base(4,13,0)   {-# INLINABLE fail #-}   fail = MonadFail.fail@@ -2871,10 +2863,6 @@ instance Monad (SpiderHostFrame x) where   {-# INLINABLE (>>=) #-}   SpiderHostFrame x >>= f = SpiderHostFrame $ x >>= runSpiderHostFrame . f-  {-# INLINABLE (>>) #-}-  SpiderHostFrame x >> SpiderHostFrame y = SpiderHostFrame $ x >> y-  {-# INLINABLE return #-}-  return x = SpiderHostFrame $ return x #if !MIN_VERSION_base(4,13,0)   {-# INLINABLE fail #-}   fail s = SpiderHostFrame $ fail s
src/Reflex/Time.hs view
@@ -33,7 +33,6 @@ import Data.Align import Data.Data (Data) import Data.Fixed-import Data.Semigroup (Semigroup(..)) import Data.Sequence (Seq, (|>)) import qualified Data.Sequence as Seq import Data.These
src/Reflex/TriggerEvent/Base.hs view
@@ -24,7 +24,6 @@ import Data.Coerce import Data.Dependent.Sum import Data.IORef-import Data.Monoid ((<>)) import qualified Data.Semigroup as S import Reflex.Class import Reflex.Adjustable.Class
test/DebugCycles.hs view
@@ -29,7 +29,7 @@ import Test.Run import Test.Hspec import Reflex.Spider.Internal (EventLoopException)-import Data.Witherable (Filterable)+import Witherable (Filterable)  #if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0)) import Data.These.Lens