Merge branch 'develop' into canhazmerge

Author: oliver-batchelor

ChangeLog.md

@@ -2,11 +2,18 @@
 
 ## Unreleased
 
-* Fix `holdDyn` so that it is lazy in its event argument
-* Generalize `merge` to `mergeG`, `mergeIncremental` to
-  `mergeIncrementalG`, and `mergeIncrementalWithMove`
-  to `mergeIncrementalWithMoveG`. These produce `DMap`s
-  whose values needn't be `Identity`.
+* Generalize merging functions:
+  `merge` to `mergeG`, 
+  `mergeIncremental` to `mergeIncrementalG`, 
+  `distributeDMapOverDynPure` to `distributeDMapOverDynPureG`,
+  `mergeIncrementalWithMove` to `mergeIncrementalWithMoveG`.  
+
+## 0.6.2.0
+
+* Fix `holdDyn` so that it is lazy in its event argument  
+  These produce `DMap`s  whose values needn't be `Identity`.
+* Stop using the now-deprecated `*Tag` classes (e.g., `ShowTag`).
+* Fix `holdDyn` so that it is lazy in its event argument.
 
 ## 0.6.1.0
 

default.nix

@@ -11,7 +11,7 @@
 }:
 mkDerivation {
   pname = "reflex";
-  version = "0.6.1";
+  version = "0.6.2.0";
   src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;
   libraryHaskellDepends = [
     base bifunctors containers dependent-map dependent-sum

reflex.cabal

@@ -1,5 +1,5 @@
 Name: reflex
-Version: 0.6.1
+Version: 0.6.2.0
 Synopsis: Higher-order Functional Reactive Programming
 Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system
 License: BSD3
@@ -44,9 +44,10 @@ library
     base >= 4.9 && < 4.13,
     bifunctors >= 5.2 && < 5.6,
     comonad,
+    constraints-extras >= 0.2,
     containers >= 0.5 && < 0.7,
     data-default >= 0.5 && < 0.8,
-    dependent-map >= 0.2.4 && < 0.3,
+    dependent-map >= 0.3 && < 0.4,
     exception-transformers == 0.4.*,
     profunctors,
     lens >= 4.7 && < 5,
@@ -134,7 +135,7 @@ library
   if flag(use-template-haskell)
     cpp-options: -DUSE_TEMPLATE_HASKELL
     build-depends:
-      dependent-sum >= 0.3 && < 0.5,
+      dependent-sum >= 0.6 && < 0.7,
       haskell-src-exts >= 1.16 && < 1.22,
       haskell-src-meta >= 0.6 && < 0.9,
       template-haskell >= 2.9 && < 2.15
@@ -143,7 +144,7 @@ library
     other-extensions: TemplateHaskell
   else
     build-depends:
-      dependent-sum == 0.4.*
+      dependent-sum == 0.6.*
 
   if flag(fast-weak) && impl(ghcjs)
     cpp-options: -DGHCJS_FAST_WEAK

src/Data/Functor/Misc.hs

@@ -52,8 +52,7 @@ import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
 import Data.Map (Map)
 import qualified Data.Map as Map
-import Data.Some (Some)
-import qualified Data.Some as Some
+import Data.Some (Some(Some))
 import Data.These
 import Data.Typeable hiding (Refl)
 
@@ -79,9 +78,6 @@ deriving instance Read k => Read (Const2 k v v)
 instance Show k => GShow (Const2 k v) where
   gshowsPrec n x@(Const2 _) = showsPrec n x
 
-instance (Show k, Show (f v)) => ShowTag (Const2 k v) f where
-  showTaggedPrec (Const2 _) = showsPrec
-
 instance Eq k => GEq (Const2 k v) where
   geq (Const2 a) (Const2 b) =
     if a == b
@@ -124,7 +120,7 @@ intMapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=
 -- | Convert a 'DMap' to a regular 'Map' by forgetting the types associated with
 -- the keys, using a function to remove the wrapping 'Functor'
 weakenDMapWith :: (forall a. v a -> v') -> DMap k v -> Map (Some k) v'
-weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some.This k, f v)) . DMap.toAscList
+weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some k, f v)) . DMap.toAscList
 
 --------------------------------------------------------------------------------
 -- WrapArg
@@ -214,11 +210,6 @@ instance GShow (EitherTag l r) where
     LeftTag -> showString "LeftTag"
     RightTag -> showString "RightTag"
 
-instance (Show l, Show r) => ShowTag (EitherTag l r) Identity where
-  showTaggedPrec t n (Identity a) = case t of
-    LeftTag -> showsPrec n a
-    RightTag -> showsPrec n a
-
 -- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.
 eitherToDSum :: Either a b -> DSum (EitherTag a b) Identity
 eitherToDSum = \case

src/Reflex/Class.hs

@@ -198,8 +198,7 @@ import qualified Data.IntMap.Strict as IntMap
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Map (Map)
 import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
-import Data.Some (Some)
-import qualified Data.Some as Some
+import Data.Some (Some(Some))
 import Data.String
 import Data.These
 import Data.Type.Coercion
@@ -1176,9 +1175,9 @@ factorEvent
   -> Event t (DSum k v)
   -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
 factorEvent k0 kv' = do
-  key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'
+  key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'
   let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
-        Some.This oldKey -> case newKey `geq` oldKey of
+        Some oldKey -> case newKey `geq` oldKey of
           Just Refl -> return Nothing
           Nothing -> do
             newInner <- filterEventKey newKey kv'

src/Reflex/Patch/DMapWithMove.hs

@@ -19,9 +19,9 @@ import Reflex.Patch.Class
 import Reflex.Patch.MapWithMove (PatchMapWithMove (..))
 import qualified Reflex.Patch.MapWithMove as MapWithMove
 
+import Data.Constraint.Extras
 import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
 import qualified Data.Dependent.Map as DMap
-import Data.Dependent.Sum (EqTag (..))
 import Data.Functor.Constant
 import Data.Functor.Misc
 import Data.Functor.Product
@@ -30,8 +30,7 @@ import Data.GADT.Show (GShow, gshow)
 import qualified Data.Map as Map
 import Data.Maybe
 import Data.Semigroup (Semigroup (..), (<>))
-import Data.Some (Some)
-import qualified Data.Some as Some
+import Data.Some (Some(Some))
 import Data.These
 
 -- | Like 'PatchMapWithMove', but for 'DMap'. Each key carries a 'NodeInfo' which describes how it will be changed by the patch and connects move sources and
@@ -105,8 +104,8 @@ validationErrorsForPatchDMapWithMove m =
     unbalancedMove _ = Nothing
 
 -- |Test whether two @'PatchDMapWithMove' k v@ contain the same patch operations.
-instance EqTag k (NodeInfo k v) => Eq (PatchDMapWithMove k v) where
-  PatchDMapWithMove a == PatchDMapWithMove b = a == b
+instance (GEq k, Has' Eq k (NodeInfo k v)) => Eq (PatchDMapWithMove k v) where
+    PatchDMapWithMove a == PatchDMapWithMove b = a == b
 
 -- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9
 data Pair1 f g a = Pair1 (f a) (g a)
@@ -311,8 +310,8 @@ weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenD
           { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
               From_Insert v -> MapWithMove.From_Insert $ f v
               From_Delete -> MapWithMove.From_Delete
-              From_Move k -> MapWithMove.From_Move $ Some.This k
-          , MapWithMove._nodeInfo_to = Some.This <$> getComposeMaybe (_nodeInfo_to ni)
+              From_Move k -> MapWithMove.From_Move $ Some k
+          , MapWithMove._nodeInfo_to = Some <$> getComposeMaybe (_nodeInfo_to ni)
           }
 
 -- |"Weaken" a @'PatchDMapWithMove' (Const2 k a) v@ to a @'PatchMapWithMove' k v'@. Weaken is in scare quotes because the 'Const2' has already disabled any

src/Reflex/Query/Base.hs

@@ -38,8 +38,7 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Monoid ((<>))
 import qualified Data.Semigroup as S
-import Data.Some (Some)
-import qualified Data.Some as Some
+import Data.Some (Some(Some))
 import Data.These
 
 import Reflex.Class
@@ -145,10 +144,10 @@ instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t
         liftedResult' = fforCheap result' $ \(PatchDMap p) -> PatchDMap $
           mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mr) -> k :=> ComposeMaybe (fmap (getQueryTLoweredResultValue . getCompose) mr)) p
         liftedBs0 :: Map (Some k) [Behavior t q]
-        liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some.This k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
+        liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
         liftedBs' :: Event t (PatchMap (Some k) [Behavior t q])
         liftedBs' = fforCheap result' $ \(PatchDMap p) -> PatchMap $
-          Map.fromDistinctAscList $ (\(k :=> ComposeMaybe mr) -> (Some.This k, fmap (getQueryTLoweredResultWritten . getCompose) mr)) <$> DMap.toList p
+          Map.fromDistinctAscList $ (\(k :=> ComposeMaybe mr) -> (Some k, fmap (getQueryTLoweredResultWritten . getCompose) mr)) <$> DMap.toList p
         sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q
         sampleBs = foldlM (\b a -> (b <>) <$> sample a) mempty
         accumBehaviors :: forall m'. MonadHold t m'
@@ -189,10 +188,10 @@ instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t
     let liftedResult0 = mapKeyValuePairsMonotonic (\(k :=> Compose r) -> k :=> getQueryTLoweredResultValue r) result0
         liftedResult' = fforCheap result' $ mapPatchDMapWithMove (getQueryTLoweredResultValue . getCompose)
         liftedBs0 :: Map (Some k) [Behavior t q]
-        liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some.This k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
+        liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
         liftedBs' :: Event t (PatchMapWithMove (Some k) [Behavior t q])
         liftedBs' = fforCheap result' $ weakenPatchDMapWithMoveWith (getQueryTLoweredResultWritten . getCompose) {- \(PatchDMap p) -> PatchMapWithMove $
-          Map.fromDistinctAscList $ (\(k :=> mr) -> (Some.This k, fmap (fmap (getQueryTLoweredResultWritten . getCompose)) mr)) <$> DMap.toList p -}
+          Map.fromDistinctAscList $ (\(k :=> mr) -> (Some k, fmap (fmap (getQueryTLoweredResultWritten . getCompose)) mr)) <$> DMap.toList p -}
         sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q
         sampleBs = foldlM (\b a -> (b <>) <$> sample a) mempty
         accumBehaviors' :: forall m'. MonadHold t m'

src/Reflex/Requester/Base.hs

@@ -66,8 +66,7 @@ import qualified Data.Map as Map
 import Data.Monoid ((<>))
 import Data.Proxy
 import qualified Data.Semigroup as S
-import Data.Some (Some)
-import qualified Data.Some as Some
+import Data.Some (Some(Some))
 import Data.Type.Equality
 import Data.Unique.Tag
 
@@ -441,7 +440,7 @@ traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchN
           pack = Entry
           f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)
           f' k (Compose (n, v)) = do
-            (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some.This k))
+            (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some k))
             return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)
       ndm' <- numberOccurrencesFrom 1 dm'
       (children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'

src/Reflex/Spider/Internal.hs

@@ -78,8 +78,7 @@ import Data.Tree (Forest, Tree (..), drawForest)
 import Data.FastWeakBag (FastWeakBag)
 import qualified Data.FastWeakBag as FastWeakBag
 import Data.Reflection
-import Data.Some (Some)
-import qualified Data.Some as Some
+import Data.Some (Some(Some))
 import Data.Type.Coercion
 import Data.Profunctor.Unsafe ((#.), (.#))
 import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)
@@ -587,7 +586,7 @@ eventSubscribedFan !subscribed = EventSubscribed
   { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed
   , eventSubscribedRetained = toAny subscribed
 #ifdef DEBUG_CYCLES
-  , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]
+  , eventSubscribedGetParents = return [Some $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]
   , eventSubscribedHasOwnHeightRef = False
   , eventSubscribedWhoCreated = whoCreatedIORef $ fanSubscribedCachedSubscribed subscribed
 #endif
@@ -600,7 +599,7 @@ eventSubscribedSwitch !subscribed = EventSubscribed
 #ifdef DEBUG_CYCLES
   , eventSubscribedGetParents = do
       s <- readIORef $ switchSubscribedCurrentParent subscribed
-      return [Some.This $ _eventSubscription_subscribed s]
+      return [Some $ _eventSubscription_subscribed s]
   , eventSubscribedHasOwnHeightRef = True
   , eventSubscribedWhoCreated = whoCreatedIORef $ switchSubscribedCachedSubscribed subscribed
 #endif
@@ -613,8 +612,8 @@ eventSubscribedCoincidence !subscribed = EventSubscribed
 #ifdef DEBUG_CYCLES
   , eventSubscribedGetParents = do
       innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed
-      let outerParent = Some.This $ _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed
-          innerParents = maybeToList $ fmap Some.This innerSubscription
+      let outerParent = Some $ _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed
+          innerParents = maybeToList $ fmap Some innerSubscription
       return $ outerParent : innerParents
   , eventSubscribedHasOwnHeightRef = True
   , eventSubscribedWhoCreated = whoCreatedIORef $ coincidenceSubscribedCachedSubscribed subscribed
@@ -630,13 +629,13 @@ whoCreatedEventSubscribed = eventSubscribedWhoCreated
 
 walkInvalidHeightParents :: EventSubscribed x -> IO [Some (EventSubscribed x)]
 walkInvalidHeightParents s0 = do
-  subscribers <- flip execStateT mempty $ ($ Some.This s0) $ fix $ \loop (Some.This s) -> do
+  subscribers <- flip execStateT mempty $ ($ Some s0) $ fix $ \loop (Some s) -> do
     h <- liftIO $ readIORef $ eventSubscribedHeightRef s
     when (h == invalidHeight) $ do
       when (eventSubscribedHasOwnHeightRef s) $ liftIO $ writeIORef (eventSubscribedHeightRef s) $! invalidHeightBeingTraversed
-      modify (Some.This s :)
+      modify (Some s :)
       mapM_ loop =<< liftIO (eventSubscribedGetParents s)
-  forM_ subscribers $ \(Some.This s) -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight
+  forM_ subscribers $ \(Some s) -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight
   return subscribers
 #endif
 
@@ -664,7 +663,7 @@ behaviorPull !p = Behavior $ do
     val <- liftIO $ readIORef $ pullValue p
     case val of
       Just subscribed -> do
-        askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some.This (BehaviorSubscribedPull subscribed)) :))
+        askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some (BehaviorSubscribedPull subscribed)) :))
         askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (pullSubscribedInvalidators subscribed) (wi:))
         liftIO $ touch $ pullSubscribedOwnInvalidator subscribed
         return $ pullSubscribedValue subscribed
@@ -683,7 +682,7 @@ behaviorPull !p = Behavior $ do
               , pullSubscribedParents = parents
               }
         liftIO $ writeIORef (pullValue p) $ Just subscribed
-        askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some.This (BehaviorSubscribedPull subscribed)) :))
+        askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some (BehaviorSubscribedPull subscribed)) :))
         return a
 
 behaviorDyn :: Patch p => Dyn x p -> Behavior x (PatchTarget p)
@@ -694,7 +693,7 @@ readHoldTracked :: Hold x p -> BehaviorM x (PatchTarget p)
 readHoldTracked h = do
   result <- liftIO $ readIORef $ holdValue h
   askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (holdInvalidators h) (wi:))
-  askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some.This (BehaviorSubscribedHold h)) :))
+  askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some (BehaviorSubscribedHold h)) :))
   liftIO $ touch h -- Otherwise, if this gets inlined enough, the hold's parent reference may get collected
   return result
 
@@ -867,23 +866,23 @@ instance HasSpiderTimeline x => Defer (Some Clear) (EventM x) where
 
 {-# INLINE scheduleClear #-}
 scheduleClear :: Defer (Some Clear) m => IORef (Maybe a) -> m ()
-scheduleClear r = defer $ Some.This $ Clear r
+scheduleClear r = defer $ Some $ Clear r
 
 instance HasSpiderTimeline x => Defer (Some IntClear) (EventM x) where
   {-# INLINE getDeferralQueue #-}
   getDeferralQueue = asksEventEnv eventEnvIntClears
 
 {-# INLINE scheduleIntClear #-}
 scheduleIntClear :: Defer (Some IntClear) m => IORef (IntMap a) -> m ()
-scheduleIntClear r = defer $ Some.This $ IntClear r
+scheduleIntClear r = defer $ Some $ IntClear r
 
 instance HasSpiderTimeline x => Defer (Some RootClear) (EventM x) where
   {-# INLINE getDeferralQueue #-}
   getDeferralQueue = asksEventEnv eventEnvRootClears
 
 {-# INLINE scheduleRootClear #-}
 scheduleRootClear :: Defer (Some RootClear) m => IORef (DMap k Identity) -> m ()
-scheduleRootClear r = defer $ Some.This $ RootClear r
+scheduleRootClear r = defer $ Some $ RootClear r
 
 instance HasSpiderTimeline x => Defer (SomeResetCoincidence x) (EventM x) where
   {-# INLINE getDeferralQueue #-}
@@ -1872,7 +1871,7 @@ mergeSubscriber m getKey = Subscriber
             else liftIO $ do
 #ifdef DEBUG_CYCLES
             nodesInvolvedInCycle <- walkInvalidHeightParents $ eventSubscribedMerge subscribed
-            stacks <- forM nodesInvolvedInCycle $ \(Some.This es) -> whoCreatedEventSubscribed es
+            stacks <- forM nodesInvolvedInCycle $ \(Some es) -> whoCreatedEventSubscribed es
             let cycleInfo = ":\n" <> drawForest (listsToForest stacks)
 #else
             let cycleInfo = ""
@@ -2116,11 +2115,11 @@ runFrame a = SpiderHost $ do
         return result
   result <- runEventM go
   toClear <- readIORef $ eventEnvClears env
-  forM_ toClear $ \(Some.This (Clear ref)) -> {-# SCC "clear" #-} writeIORef ref Nothing
+  forM_ toClear $ \(Some (Clear ref)) -> {-# SCC "clear" #-} writeIORef ref Nothing
   toClearInt <- readIORef $ eventEnvIntClears env
-  forM_ toClearInt $ \(Some.This (IntClear ref)) -> {-# SCC "intClear" #-} writeIORef ref $! IntMap.empty
+  forM_ toClearInt $ \(Some (IntClear ref)) -> {-# SCC "intClear" #-} writeIORef ref $! IntMap.empty
   toClearRoot <- readIORef $ eventEnvRootClears env
-  forM_ toClearRoot $ \(Some.This (RootClear ref)) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty
+  forM_ toClearRoot $ \(Some (RootClear ref)) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty
   toAssign <- readIORef $ eventEnvAssignments env
   toReconnectRef <- newIORef []
   coincidenceInfos <- readIORef $ eventEnvResetCoincidences env
@@ -2480,7 +2479,7 @@ unsafeNewSpiderTimelineEnv = do
 
 -- | Create a new SpiderTimelineEnv
 newSpiderTimeline :: IO (Some SpiderTimelineEnv)
-newSpiderTimeline = withSpiderTimeline (pure . Some.This)
+newSpiderTimeline = withSpiderTimeline (pure . Some)
 
 data LocalSpiderTimeline (x :: Type) s