Merge remote-tracking branch 'origin/develop' into cleanup-debug

Author: lpsmith

.travis.yml

@@ -28,6 +28,8 @@ matrix:
   include:
     - compiler: ghcjs-8.4
       addons: {"apt":{"sources":["hvr-ghc"],"packages":["cabal-install-3.0"]}}
+    - compiler: ghc-8.8.1
+      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}
     - compiler: ghc-8.6.5
       addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}
     - compiler: ghc-8.4.4
@@ -163,7 +165,7 @@ script:
   # Constraint set no-th
   - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='reflex -use-template-haskell' all | color_cabal_output
   # Constraint set old-these
-  - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='these <1' all | color_cabal_output
+  - if $GHCJS || ! $GHCJS && [ $HCNUMVER -lt 80800 ] ; then ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='these <1' all | color_cabal_output ; fi
   # Constraint set old-witherable
   - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='witherable <0.3.2' all | color_cabal_output
   # Constraint set debug-propagation

ChangeLog.md

@@ -2,9 +2,12 @@
 
 ## Unreleased
 
-* Data.WeakBag.traverse and Data.FastWeakBag.traverse have been
-  renamed to Data.WeakBag.traverse_ and Data.FastWeakBag.traverse_
-  respectively.
+* Add `Reflex.Query.Base.mapQueryT`. See that module for documentation
+
+## 0.6.3
+
+* `Data.WeakBag.traverse` and `Data.FastWeakBag.traverse` have been deprecated.
+  They are replaced with `Data.WeakBag.traverse_` and `Data.FastWeakBag.traverse_`, respectively.
 
 * Fixes a bug in `Reflex.Patch.MapWithMove.patchThatSortsMapWith` that was producing invalid `PatchMapWithMove`.
 

cabal.haskell-ci

@@ -10,6 +10,7 @@ constraint-set no-th
   constraints: reflex -use-template-haskell
 
 constraint-set old-these
+  ghc: <8.8
   constraints: these <1
 
 constraint-set old-witherable

dep/reflex-platform/github.json

@@ -1,7 +1,7 @@
 {
   "owner": "reflex-frp",
   "repo": "reflex-platform",
-  "branch": "develop",
-  "rev": "e7b76dd552a10916c7d8702c11292dac4f4299ea",
-  "sha256": "0s1183arrwldcs50qhzgnv94v24n9bgq6dfq64wp0a3q2nzyvgwh"
+  "branch": "master",
+  "rev": "510b990d0b11f0626afbec5fe8575b5b2395391b",
+  "sha256": "09cmahsbxr0963wq171c7j139iyzz49hramr4v9nsf684wcwkngv"
 }

reflex.cabal

@@ -1,5 +1,5 @@
 Name: reflex
-Version: 0.6.2.4
+Version: 0.6.3
 Synopsis: Higher-order Functional Reactive Programming
 Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system
 License: BSD3
@@ -18,7 +18,7 @@ extra-source-files:
   ChangeLog.md
 
 tested-with:
-  GHC  ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5,
+  GHC  ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1,
   GHCJS ==8.4
 
 flag use-reflex-optimizer
@@ -61,7 +61,7 @@ library
   hs-source-dirs: src
   build-depends:
     MemoTrie == 0.6.*,
-    base >= 4.9 && < 4.13,
+    base >= 4.9 && < 4.14,
     bifunctors >= 5.2 && < 5.6,
     comonad >= 5.0.4 && < 5.1,
     constraints-extras >= 0.3 && < 0.4,
@@ -74,14 +74,14 @@ library
     mtl >= 2.1 && < 2.3,
     prim-uniq >= 0.1.0.1 && < 0.2,
     primitive >= 0.5 && < 0.8,
-    profunctors >= 5.0 && < 5.5,
+    profunctors >= 5.3 && < 5.6,
     random == 1.1.*,
     ref-tf == 0.4.*,
     reflection == 2.1.*,
     semigroupoids >= 4.0 && < 6,
     stm >= 2.4 && < 2.6,
     syb >= 0.5 && < 0.8,
-    time >= 1.4 && < 1.9,
+    time >= 1.4 && < 1.10,
     transformers >= 0.5.6.0 && < 0.6,
     unbounded-delays >= 0.1.0.0 && < 0.2,
     witherable >= 0.3 && < 0.3.2
@@ -168,9 +168,9 @@ library
     cpp-options: -DUSE_TEMPLATE_HASKELL
     build-depends:
       dependent-sum >= 0.6 && < 0.7,
-      haskell-src-exts >= 1.16 && < 1.22,
+      haskell-src-exts >= 1.16 && < 1.23,
       haskell-src-meta >= 0.6 && < 0.9,
-      template-haskell >= 2.9 && < 2.15
+      template-haskell >= 2.9 && < 2.16
     exposed-modules:
       Reflex.Dynamic.TH
     other-extensions: TemplateHaskell

release.nix

@@ -34,6 +34,9 @@ let
                   "release.nix"
                   ".git"
                   "dist"
+                  "cabal.haskell-ci"
+                  "cabal.project"
+                  ".travis.yml"
                 ])) ./.;
               };
             })

src/Data/AppendMap.hs

@@ -20,7 +20,7 @@ module Data.AppendMap
   , module Data.Map.Monoidal
   ) where
 
-import Prelude hiding (map, null)
+import Prelude hiding (null)
 
 import Data.Coerce
 import Data.Default

src/Data/Functor/Misc.hs

@@ -53,6 +53,7 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Some (Some(Some))
 import Data.These
+import Data.Type.Equality ((:~:)(Refl))
 import Data.Typeable hiding (Refl)
 
 --------------------------------------------------------------------------------

src/Reflex/Class.hs

@@ -200,7 +200,7 @@ import Data.Dependent.Map (DMap, DSum (..))
 import qualified Data.Dependent.Map as DMap
 import Data.Functor.Compose
 import Data.Functor.Product
-import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
+import Data.GADT.Compare (GEq (..), GCompare (..))
 import Data.FastMutableIntMap (PatchIntMap)
 import Data.Foldable
 import Data.Functor.Bind
@@ -215,6 +215,7 @@ import Data.Some (Some(Some))
 import Data.String
 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)
@@ -286,7 +287,8 @@ class ( MonadHold t (PushM t)
   -- | Create an 'Event' that will occur whenever the currently-selected input
   -- 'Event' occurs
   switch :: Behavior t (Event t a) -> Event t a
-  -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring
+  -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring.
+  --   You maybe looking for '@switchHold@ @never@' instead.
   coincidence :: Event t (Event t a) -> Event t a
   -- | Extract the 'Behavior' of a 'Dynamic'.
   current :: Dynamic t a -> Behavior t a
@@ -662,7 +664,9 @@ 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, Monoid a) => Monoid (Behavior t a) where
   mempty = constant mempty

src/Reflex/Dynamic.hs

@@ -87,11 +87,12 @@ import Data.Align
 import Data.Dependent.Map (DMap)
 import qualified Data.Dependent.Map as DMap
 import Data.Dependent.Sum (DSum (..))
-import Data.GADT.Compare ((:~:) (..), GCompare (..), GEq (..), GOrdering (..))
+import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..))
 import Data.Map (Map)
 import Data.Maybe
 import Data.Monoid ((<>))
 import Data.These
+import Data.Type.Equality ((:~:) (..))
 
 import Debug.Trace
 

src/Reflex/DynamicWriter/Class.hs

@@ -26,4 +26,3 @@ class (Monad m, Monoid w) => DynamicWriter t w m | m -> t w where
 
 instance DynamicWriter t w m => DynamicWriter t w (ReaderT r m) where
   tellDyn = lift . tellDyn
-

src/Reflex/PerformEvent/Base.hs

@@ -141,7 +141,7 @@ hostPerformEventT a = do
           case mToPerform of
             Nothing -> return [result']
             Just toPerform -> do
-              responses <- runHostFrame $ traverseRequesterData (Identity <$>) toPerform
+              responses <- runHostFrame $ traverseRequesterData (fmap Identity) toPerform
               mrt <- readRef responseTrigger
               let followupEventTriggers = case mrt of
                     Just rt -> [rt :=> Identity responses]

src/Reflex/Query/Base.hs

@@ -16,6 +16,7 @@ module Reflex.Query.Base
   , mapQueryResult
   , dynWithQueryT
   , withQueryT
+  , mapQueryT
   ) where
 
 import Control.Applicative (liftA2)
@@ -287,6 +288,10 @@ withQueryT f a = do
     (fmapCheap (AdditivePatch . mapQuery f . unAdditivePatch) $ updatedIncremental q)
   return result
 
+-- | Maps a function over a 'QueryT' that can change the underlying monad
+mapQueryT :: (forall b. m b -> n b) -> QueryT t q m a -> QueryT t q n a
+mapQueryT f (QueryT a) = QueryT $ mapStateT (mapEventWriterT (mapReaderT f)) a
+
 -- | dynWithQueryT's (Dynamic t QueryMorphism) argument needs to be a group homomorphism at all times in order to behave correctly
 dynWithQueryT :: (MonadFix m, PostBuild t m, Group q, Additive q, Group q', Additive q', Query q')
            => Dynamic t (QueryMorphism q q')

src/Reflex/Spider/Internal.hs

@@ -43,6 +43,8 @@ import Control.Monad.Reader.Class
 import Control.Monad.IO.Class
 import Control.Monad.ReaderIO
 import Control.Monad.Ref
+import Control.Monad.Fail (MonadFail)
+import qualified Control.Monad.Fail as MonadFail
 import Data.Align
 import Data.Coerce
 import Data.Dependent.Map (DMap, DSum (..))
@@ -63,6 +65,7 @@ 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 (..))
@@ -944,8 +947,10 @@ instance Monad (BehaviorM x) where
   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
+#endif
 
 data BehaviorSubscribed x a
    = forall p. BehaviorSubscribedHold (Hold x p)
@@ -2486,8 +2491,10 @@ instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x))
   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'"
+#endif
 
 {-# INLINABLE newJoinDyn #-}
 newJoinDyn :: HasSpiderTimeline x => DynamicS x (Identity (DynamicS x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)
@@ -2766,8 +2773,14 @@ instance Monad (SpiderHost x) where
   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
+#endif
+
+instance MonadFail (SpiderHost x) where
   {-# INLINABLE fail #-}
-  fail s = SpiderHost $ fail s
+  fail s = SpiderHost $ MonadFail.fail s
 
 -- | Run an action affecting the global Spider timeline; this will be guarded by
 -- a mutex for that timeline
@@ -2789,8 +2802,10 @@ instance Monad (SpiderHostFrame x) where
   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
+#endif
 
 instance NotReady (SpiderTimeline x) (SpiderHostFrame x) where
   notReadyUntil _ = pure ()

test/hlint.hs

@@ -30,16 +30,9 @@ main = do
         ]
       matchFile = and <$> sequence
         [ extension ==? ".hs"
-        , let notElem' = liftOp notElem
-          in filePath `notElem'` filePathExceptions pwd
         ]
   files <- find recurseInto matchFile (pwd </> "src") --TODO: Someday fix all hints in tests, etc.
   ideas <- fmap concat $ forM files $ \f -> do
     putStr $ "linting file " ++ drop (length pwd + 1) f ++ "... "
     runHlint f
   if null ideas then exitSuccess else exitFailure
-
-filePathExceptions :: FilePath -> [FilePath]
-filePathExceptions pwd = map (pwd </>) $
-  [ "src/Data/AppendMap.hs" -- parse error when hlint runs
-  ]