Merge pull request #477 from reflex-frp/aa/patch007

Use patch >= 0.0.7

ChangeLog.md

@@ -2,7 +2,8 @@
 
 ## Unreleased
 
-Fix build for GHC 9.2
+* Fix build for GHC 9.2
+* Require patch >= 0.0.7.0
 
 ## 0.8.2.0
 

dep/reflex-platform/default.nix

@@ -1,7 +1,2 @@
 # DO NOT HAND-EDIT THIS FILE
-import ((import <nixpkgs> {}).fetchFromGitHub (
-  let json = builtins.fromJSON (builtins.readFile ./github.json);
-  in { inherit (json) owner repo rev sha256;
-       private = json.private or false;
-     }
-))
+import (import ./thunk.nix)

dep/reflex-platform/github.json

@@ -2,6 +2,7 @@
   "owner": "reflex-frp",
   "repo": "reflex-platform",
   "branch": "develop",
-  "rev": "f628398d076243a0851b27e625b37f65dff9b89b",
-  "sha256": "0sl0hf1glgyb1vmf2mhw4r9ipmcqk1y19d3wsic7dix2jwywzrh9"
+  "private": false,
+  "rev": "ac66356c8839d1dc16cc60887c2db5988a60e6c4",
+  "sha256": "0zk8pf72lid6cqq4mlr1mcwh6zd5lz9i83kw519aci6mfba1afvq"
 }

dep/reflex-platform/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

reflex.cabal

@@ -1,6 +1,5 @@
 Name: reflex
-Version: 0.8.2.0
-x-revision: 2
+Version: 0.8.2.1
 Synopsis: Higher-order Functional Reactive Programming
 Description:
   Interactive programs without callbacks or side-effects.
@@ -75,6 +74,7 @@ library
     base >= 4.11 && < 4.17,
     bifunctors >= 5.2 && < 5.6,
     comonad >= 5.0.4 && < 5.1,
+    commutative-semigroups >= 0.1 && <0.2,
     constraints >= 0.10 && <0.14,
     constraints-extras >= 0.3 && < 0.4,
     containers >= 0.6 && < 0.7,
@@ -85,7 +85,7 @@ library
     mmorph >= 1.0 && < 1.2,
     monad-control >= 1.0.1 && < 1.1,
     mtl >= 2.1 && < 2.3,
-    patch >= 0.0.1 && < 0.1,
+    patch >= 0.0.7 && < 0.1,
     prim-uniq >= 0.1.0.1 && < 0.3,
     primitive >= 0.5 && < 0.8,
     profunctors >= 5.3 && < 5.7,
@@ -376,6 +376,7 @@ test-suite QueryT
   main-is: QueryT.hs
   hs-source-dirs: test
   build-depends: base
+               , commutative-semigroups
                , containers
                , dependent-map
                , dependent-sum

release.nix

@@ -27,6 +27,18 @@ let
           inherit system;
           __useTemplateHaskell = variation == "reflex"; # TODO hack
           haskellOverlays = [
+            (self: super: {
+              commutative-semigroups = self.callHackageDirect {
+                pkg = "commutative-semigroups";
+                ver = "0.1.0.0";
+                sha256 = "0xmv20n3iqjc64xi3c91bwqrg8x79sgipmflmk21zz4rj9jdkv8i";
+              } {};
+              patch = self.callHackageDirect {
+                pkg = "patch";
+                ver = "0.0.7.0";
+                sha256 = "0yr2hk3fpwjxi1z0n384k3aq9b3z00c02bbwqybcj3n20l4k17l6";
+              } {};
+            })
             # Use this package's source for reflex
             (self: super: {
               _dep = super._dep // {

src/Reflex/Query/Base.hs

@@ -42,6 +42,7 @@ 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))
 import Data.These
 
@@ -64,7 +65,7 @@ newtype QueryT t q m a = QueryT { unQueryT :: StateT [Behavior t q] (EventWriter
 deriving instance MonadHold t m => MonadHold t (QueryT t q m)
 deriving instance MonadSample t m => MonadSample t (QueryT t q m)
 
-runQueryT :: (MonadFix m, Additive q, Group q, Reflex t) => QueryT t q m a -> Dynamic t (QueryResult q) -> m (a, Incremental t (AdditivePatch q))
+runQueryT :: (MonadFix m, Commutative q, Group q, Reflex t) => QueryT t q m a -> Dynamic t (QueryResult q) -> m (a, Incremental t (AdditivePatch q))
 runQueryT (QueryT a) qr = do
   ((r, bs), es) <- runReaderT (runEventWriterT (runStateT a mempty)) qr
   return (r, unsafeBuildIncremental (foldlM (\b c -> (b <>) <$> sample c) mempty bs) (fmapCheap AdditivePatch es))
@@ -80,7 +81,7 @@ getQueryTLoweredResultWritten (QueryTLoweredResult (_, w)) = w
 maskMempty :: (Eq a, Monoid a) => a -> Maybe a
 maskMempty x = if x == mempty then Nothing else Just x
 
-instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t m, Adjustable t m) => Adjustable t (QueryT t q m) where
+instance (Reflex t, MonadFix m, Group q, Commutative q, Query q, Eq q, MonadHold t m, Adjustable t m) => Adjustable t (QueryT t q m) where
   runWithReplace (QueryT a0) a' = do
     ((r0, bs0), r') <- QueryT $ lift $ runWithReplace (runStateT a0 []) $ fmapCheap (flip runStateT [] . unQueryT) a'
     let sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q
@@ -283,7 +284,7 @@ instance (S.Semigroup a, Monad m) => S.Semigroup (QueryT t q m a) where
   (<>) = liftA2 (S.<>)
 
 -- | withQueryT's QueryMorphism argument needs to be a group homomorphism in order to behave correctly
-withQueryT :: (MonadFix m, PostBuild t m, Group q, Group q', Additive q, Additive q', Query q')
+withQueryT :: (MonadFix m, PostBuild t m, Group q, Group q', Commutative q, Commutative q', Query q')
            => QueryMorphism q q'
            -> QueryT t q m a
            -> QueryT t q' m a
@@ -300,7 +301,7 @@ 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')
+dynWithQueryT :: (MonadFix m, PostBuild t m, Group q, Commutative q, Group q', Commutative q', Query q')
            => Dynamic t (QueryMorphism q q')
            -> QueryT t q m a
            -> QueryT t q' m a
@@ -325,7 +326,7 @@ dynWithQueryT f q = do
                    return $ Just $ AdditivePatch $ mconcat [ g a bOld, negateG (g aOld bOld), g a b]
          in unsafeBuildIncremental (g <$> sample (current da) <*> sample (currentIncremental ib)) ec
 
-instance (Monad m, Group q, Additive q, Query q, Reflex t) => MonadQuery t q (QueryT t q m) where
+instance (Monad m, Group q, Commutative q, Query q, Reflex t) => MonadQuery t q (QueryT t q m) where
   tellQueryIncremental q = do
     QueryT (modify (currentIncremental q:))
     QueryT (lift (tellEvent (fmapCheap unAdditivePatch (updatedIncremental q))))

src/Reflex/Query/Class.hs

@@ -38,6 +38,7 @@ 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 ((<>))
 import Foreign.Storable
@@ -124,7 +125,7 @@ instance Monoid SelectedCount where
 instance Group SelectedCount where
   negateG (SelectedCount a) = SelectedCount (negate a)
 
-instance Additive SelectedCount
+instance Commutative SelectedCount
 
 -- | The Semigroup\/Monoid\/Group instances for a Query containing 'SelectedCount's should use
 -- this function which returns Nothing if the result is 0. This allows the pruning of leaves
@@ -134,7 +135,7 @@ combineSelectedCounts (SelectedCount i) (SelectedCount j) = if i == negate j the
 
 -- | A class that allows sending of 'Query's and retrieval of 'QueryResult's. See 'queryDyn' for a commonly
 -- used interface.
-class (Group q, Additive q, Query q, Monad m) => MonadQuery t q m | m -> q t where
+class (Group q, Commutative q, Query q, Monad m) => MonadQuery t q m | m -> q t where
   tellQueryIncremental :: Incremental t (AdditivePatch q) -> m ()
   askQueryResult :: m (Dynamic t (QueryResult q))
   queryIncremental :: Incremental t (AdditivePatch q) -> m (Dynamic t (QueryResult q))

test/QueryT.hs

@@ -17,6 +17,7 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Map.Monoidal (MonoidalMap)
 import Data.Semigroup
+import Data.Semigroup.Commutative
 import Data.These
 
 #if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
@@ -28,7 +29,7 @@ import Data.Patch.MapWithMove
 import Test.Run
 
 newtype MyQuery = MyQuery SelectedCount
-  deriving (Show, Read, Eq, Ord, Monoid, Semigroup, Additive, Group)
+  deriving (Show, Read, Eq, Ord, Monoid, Semigroup, Commutative, Group)
 
 instance Query MyQuery where
   type QueryResult MyQuery = ()
@@ -62,7 +63,7 @@ instance (Ord k, Eq a, Monoid a, Align (MonoidalMap k)) => Monoid (Selector k a)
 instance (Eq a, Ord k, Group a, Align (MonoidalMap k)) => Group (Selector k a) where
   negateG = fmap negateG
 
-instance (Eq a, Ord k, Group a, Align (MonoidalMap k)) => Additive (Selector k a)
+instance (Eq a, Ord k, Group a, Align (MonoidalMap k)) => Commutative (Selector k a)
 
 main :: IO ()
 main = do