Merge pull request #294 from reflex-frp/release/0.6.1

Release/0.6.1

Author: ali-abrar

ChangeLog.md

@@ -10,3 +10,8 @@
 * Add withRequesterT to map functions over the request and response of a RequesterT.
 * Suppress nil patches in QueryT as an optimization. The Query type must now have an Eq instance.
 * Add throttleBatchWithLag to Reflex.Time. See that module for details.
+
+## 0.6.1.0
+
+* Re-export all of Data.Map.Monoidal
+* Fix QueryT and RequesterT tests

default.nix

@@ -11,7 +11,7 @@
 }:
 mkDerivation {
   pname = "reflex";
-  version = "0.5.0.1";
+  version = "0.6.1";
   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
+Version: 0.6.1
 Synopsis: Higher-order Functional Reactive Programming
 Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system
 License: BSD3

src/Data/AppendMap.hs

@@ -26,9 +26,8 @@ import qualified Data.Map.Internal.Debug as Map (showTree, showTreeWith)
 #else
 import qualified Data.Map as Map (showTree, showTreeWith)
 #endif
-import Data.Witherable (Filterable(..))
-import Data.Map.Monoidal (MonoidalMap(..), delete, null, empty)
-import qualified Data.Map.Monoidal as M
+import qualified Data.Witherable as W
+import Data.Map.Monoidal
 
 {-# DEPRECATED AppendMap "Use 'MonoidalMap' instead" #-}
 type AppendMap = MonoidalMap
@@ -40,8 +39,8 @@ _unAppendMap = getMonoidalMap
 pattern AppendMap :: Map k v -> MonoidalMap k v
 pattern AppendMap m = MonoidalMap m
 
-instance Filterable (MonoidalMap k) where
-  mapMaybe = M.mapMaybe
+instance W.Filterable (MonoidalMap k) where
+  mapMaybe = mapMaybe
 
 -- | Deletes a key, returning 'Nothing' if the result is empty.
 nonEmptyDelete :: Ord k => k -> MonoidalMap k a -> Maybe (MonoidalMap k a)

src/Reflex/Dynamic.hs

@@ -219,7 +219,7 @@ distributeListOverDynPure =
 -- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'
 -- with the current values of the 'Dynamic's in a map.
 joinDynThroughMap :: forall t k a. (Reflex t, Ord k) => Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
-joinDynThroughMap = join . fmap distributeMapOverDynPure
+joinDynThroughMap = (distributeMapOverDynPure =<<)
 
 -- | Print the value of the 'Dynamic' when it is first read and on each
 -- subsequent change that is observed (as 'traceEvent'), prefixed with the

src/Reflex/FunctorMaybe.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE CPP #-}
+#if MIN_VERSION_base(4,9,0)
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StandaloneDeriving #-}
+#endif
 
 -- |
 -- Module:

test/EventWriterT.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RecursiveDo #-}
@@ -36,6 +37,9 @@ main = do
   print os4
   os5@[[Nothing, Just [1, 2]]] <- runApp' (unwrapApp testLiveTellEventDMap) [Just ()]
   print os5
+  os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
+  print os6
+  let ![[Nothing, Nothing]] = os6
   return ()
 
 unwrapApp :: (Reflex t, Monad m) => (a -> EventWriterT t [Int] m ()) -> a -> m (Event t [Int])
@@ -112,3 +116,17 @@ testLiveTellEventDMap pulse = do
           (mapToDMap $ M.singleton 1 ())
           ((PatchDMap $ DMap.map (ComposeMaybe . Just) $ mapToDMap $ M.singleton 2 ()) <$ pulse)
   return ()
+
+delayedPulse
+  :: forall t m
+  .  ( Reflex t
+     , Adjustable t m
+     , MonadHold t m
+     , MonadFix m
+     )
+  => Event t ()
+  -> EventWriterT t [Int] m ()
+delayedPulse pulse = void $ flip runWithReplace (pure () <$ pulse) $ do
+    -- This has the effect of delaying pulse' from pulse
+    (_, pulse') <- runWithReplace (pure ()) $ pure [1] <$ pulse
+    tellEvent pulse'

test/RequesterT.hs

@@ -2,13 +2,17 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module Main where
 
 import Control.Lens
 import Control.Monad
+import Control.Monad.Fix
 import qualified Data.Dependent.Map as DMap
 import Data.Dependent.Sum
+import Data.Functor.Misc
+import qualified Data.Map as M
 import Data.These
 
 import Reflex
@@ -25,15 +29,27 @@ main = do
     [ Just ()
     ]
   print os1
-  let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
   os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $
     [ This ()
     , That ()
     , This ()
     , These () ()
     ]
   print os2
-  let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
+  os3 <- runApp' (unwrapApp testMoribundRequest) [Just ()]
+  print os3
+  os4 <- runApp' (unwrapApp testMoribundRequestDMap) [Just ()]
+  print os4
+  os5 <- runApp' (unwrapApp testLiveRequestDMap) [Just ()]
+  print os5
+  os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
+  print os6
+  let ![[Just [1,2,3,4,5,6,7,8,9,10]]] = os1 -- The order is reversed here: see the documentation for 'runRequesterT'
+  let ![[Just [9,7,5,3,1]],[Nothing,Nothing],[Just [10,8,6,4,2]],[Just [10,8,6,4,2],Nothing]] = os2
+  let ![[Nothing, Just [2]]] = os3
+  let ![[Nothing, Just [2]]] = os4
+  let ![[Nothing, Just [1, 2]]] = os5
+  -- let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
   return ()
 
 unwrapRequest :: DSum tag RequestInt -> Int
@@ -67,3 +83,87 @@ testSimultaneous pulse = do
       switchE = fmapMaybe (^? there) pulse
   forM_ [1,3..9] $ \i -> runWithReplace (requestingIdentity (RequestInt i <$ tellE)) $ ffor switchE $ \_ ->
     requestingIdentity (RequestInt (i+1) <$ tellE)
+
+-- | Test that a widget requesting and event which fires at the same time it has been replaced
+-- doesn't count along with the new widget.
+testMoribundRequest
+  :: forall t m
+  .  ( Reflex t
+     , Adjustable t m
+     , MonadHold t m
+     , MonadFix m
+     , Response m ~ Identity
+     , Request m ~ RequestInt
+     , Requester t m
+     )
+  => Event t ()
+  -> m ()
+testMoribundRequest pulse = do
+  rec let requestIntOnReplace x = requestingIdentity $ RequestInt x <$ rwrFinished
+      (_, rwrFinished) <- runWithReplace (requestIntOnReplace 1) $ requestIntOnReplace 2 <$ pulse
+  return ()
+
+-- | The equivalent of 'testMoribundRequest' for 'traverseDMapWithKeyWithAdjust'.
+testMoribundRequestDMap
+  :: forall t m
+  .  ( Reflex t
+     , Adjustable t m
+     , MonadHold t m
+     , MonadFix m
+     , Response m ~ Identity
+     , Request m ~ RequestInt
+     , Requester t m
+     )
+  => Event t ()
+  -> m ()
+testMoribundRequestDMap pulse = do
+  rec let requestIntOnReplace :: Int -> m ()
+          requestIntOnReplace x = void $ requestingIdentity $ RequestInt x <$ rwrFinished
+      (_, rwrFinished :: Event t (PatchDMap (Const2 () Int) Identity)) <-
+        traverseDMapWithKeyWithAdjust
+          (\(Const2 ()) (Identity v) -> Identity . const v <$> requestIntOnReplace v)
+          (mapToDMap $ M.singleton () 1)
+          ((PatchDMap $ DMap.map (ComposeMaybe . Just) $ mapToDMap $ M.singleton () 2) <$ pulse)
+  return ()
+
+-- | Ensures that elements which are _not_ removed can still fire requests
+-- during the same frame as other elements are updated.
+testLiveRequestDMap
+  :: forall t m
+  .  ( Reflex t
+     , Adjustable t m
+     , MonadHold t m
+     , MonadFix m
+     , Response m ~ Identity
+     , Request m ~ RequestInt
+     , Requester t m
+     )
+  => Event t ()
+  -> m ()
+testLiveRequestDMap pulse = do
+  rec let requestIntOnReplace :: Int -> m ()
+          requestIntOnReplace x = void $ requestingIdentity $ RequestInt x <$ rwrFinished
+      (_, rwrFinished :: Event t (PatchDMap (Const2 Int ()) Identity)) <-
+        traverseDMapWithKeyWithAdjust
+          (\(Const2 k) (Identity ()) -> Identity <$> requestIntOnReplace k)
+          (mapToDMap $ M.singleton 1 ())
+          ((PatchDMap $ DMap.map (ComposeMaybe . Just) $ mapToDMap $ M.singleton 2 ()) <$ pulse)
+  return ()
+
+delayedPulse
+  :: forall t m
+  .  ( Reflex t
+     , Adjustable t m
+     , MonadHold t m
+     , MonadFix m
+     , Response m ~ Identity
+     , Request m ~ RequestInt
+     , PerformEvent t m
+     , Requester t m
+     )
+  => Event t ()
+  -> m ()
+delayedPulse pulse = void $ flip runWithReplace (pure () <$ pulse) $ do
+    -- This has the effect of delaying pulse' from pulse
+    (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse
+    requestingIdentity pulse'