reflex 0.6 → 0.6.1

raw patch · 7 files changed

+133/−9 lines, 7 files

Files

• ChangeLog.md +5/−0
• reflex.cabal +1/−1
• src/Data/AppendMap.hs +4/−5
• src/Reflex/Dynamic.hs +1/−1
• src/Reflex/FunctorMaybe.hs +2/−0
• test/EventWriterT.hs +18/−0
• test/RequesterT.hs +102/−2

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

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

@@ -26,9 +26,8 @@ #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 @@ 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)

@@ -219,7 +219,7 @@ -- | 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

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

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RecursiveDo #-}@@ -36,6 +37,9 @@   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 @@           (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'

@@ -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,7 +29,6 @@     [ Just ()     ]   print os1-  let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1   os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $     [ This ()     , That ()@@ -33,7 +36,20 @@     , 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 @@       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'