diff --git a/ChangeLog.md b/ChangeLog.md index 84fd3f65..baac3b57 100644 --- a/ChangeLog.md +++ b/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 diff --git a/dep/reflex-platform/default.nix b/dep/reflex-platform/default.nix index 7a047786..2b4d4ab1 100644 --- a/dep/reflex-platform/default.nix +++ b/dep/reflex-platform/default.nix @@ -1,7 +1,2 @@ # DO NOT HAND-EDIT THIS FILE -import ((import {}).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) \ No newline at end of file diff --git a/dep/reflex-platform/github.json b/dep/reflex-platform/github.json index 66cd618f..9f4cbaa2 100644 --- a/dep/reflex-platform/github.json +++ b/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" } diff --git a/dep/reflex-platform/thunk.nix b/dep/reflex-platform/thunk.nix new file mode 100644 index 00000000..bbf2dc18 --- /dev/null +++ b/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 {}).fetchFromGitHub { + inherit owner repo rev sha256 fetchSubmodules private; + }; + json = builtins.fromJSON (builtins.readFile ./github.json); +in fetch json \ No newline at end of file diff --git a/reflex.cabal b/reflex.cabal index 1e776bec..958a6136 100644 --- a/reflex.cabal +++ b/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 diff --git a/release.nix b/release.nix index 25b5b830..3d1b11c4 100644 --- a/release.nix +++ b/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 // { diff --git a/src/Reflex/Query/Base.hs b/src/Reflex/Query/Base.hs index ef09e051..59eaa0db 100644 --- a/src/Reflex/Query/Base.hs +++ b/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)))) diff --git a/src/Reflex/Query/Class.hs b/src/Reflex/Query/Class.hs index 0e333ced..dc6a6888 100644 --- a/src/Reflex/Query/Class.hs +++ b/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)) diff --git a/test/QueryT.hs b/test/QueryT.hs index 47566510..2262e38d 100644 --- a/test/QueryT.hs +++ b/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