Merge pull request #25 from alexfmpe/ghc-9.8

Build with 9.8
obsidiansystems · Oct 2, 2024 · 4e908a3 · 4e908a3
2 parents a0c70db + abaefc7
commit 4e908a3
Show file tree

Hide file tree

Showing 2 changed files with 58 additions and 63 deletions.
diff --git a/tutorial/Tutorial.md b/tutorial/Tutorial.md
@@ -53,6 +53,9 @@ data Qsimple g = Qsimple
   , _q_latestPostId :: GrpMap () g -- ^ morally a "bool"; for if the maxPost Id is being requested.
   } deriving (Eq, Ord, Show, Read)
 
+newtype GrpMap k v = GrpMap { unGrpMap :: Map k v } deriving (Eq, Ord, Show, Read)
+type role GrpMap nominal nominal
+
 ```
 
 And the corresponding result type.  Note that we have the same set of fields occur in both.
@@ -73,13 +76,45 @@ have queries, and one of them "goes away", then we can either add the remaining
 have.  The latter is almost always quicker.
 
 ```haskell
-
 instance (Eq g, Monoid g) => Semigroup (Qsimple g) where Qsimple x y <> Qsimple x' y' = Qsimple (x <> x') (y <> y')
 instance (Eq g, Monoid g) => Monoid (Qsimple g) where mempty = Qsimple mempty mempty
 instance (Eq g, Group g) => Group (Qsimple g) where negateG (Qsimple x y) = Qsimple (negateG x) (negateG y)
 instance (Eq g, Monoid g, Commutative g) => Commutative (Qsimple g)
 instance GrpFunctor Qsimple where mapG f (Qsimple x y) = Qsimple (mapG f x) (mapG f y)
 
+class (forall g. (Eq g, Group g) => Group (f g)) => GrpFunctor f where
+  mapG :: (Eq b, Group b) => (a -> b) -> f a -> f b
+
+instance (Monoid g, Eq g, Ord k) => Semigroup (GrpMap k g) where
+  GrpMap xs <> GrpMap ys = GrpMap $ Map.merge id id (Map.zipWithMaybeMatched $ const $ liftNonZero (<>)) xs ys
+
+
+instance (Monoid g, Eq g, Ord k) => Monoid (GrpMap k g) where
+  mempty = GrpMap Map.empty
+  mappend = (<>)
+
+instance (Group g, Eq g, Ord k) => Group (GrpMap k g) where
+  negateG (GrpMap xs) = GrpMap $ fmap negateG xs
+  GrpMap xs ~~ GrpMap ys = GrpMap $ Map.merge id (Map.mapMissing $ const $ negateG) (Map.zipWithMaybeMatched $ const $ liftNonZero (~~)) xs ys
+
+liftNonZero :: (Monoid a, Eq a) => (a -> a -> a) -> a -> a -> Maybe a
+liftNonZero f x y = if (xy /= mempty)
+  then Just x
+  else Nothing
+  where xy = f x y
+
+-- distributive functors can still be groups.
+instance GrpFunctor ((->) r) where mapG = fmap
+instance GrpFunctor Proxy where mapG = fmap
+instance GrpFunctor Identity where mapG = fmap
+
+instance Ord k => GrpFunctor (GrpMap k) where
+  mapG f (GrpMap xs) = GrpMap $ Map.mapMaybe (\x ->
+    let fx = f x
+    in if fx /= mempty
+    then Just fx
+    else Nothing) xs
+
 ```
 
 MonadQuery Also requires that QueryResult be a monoid;  this reflects the idea
@@ -125,7 +160,7 @@ by examining the corresponding field.
 
 ```haskell
 
-watchPost 
+watchPost
   :: ( MonadQuery t (Qsimple SelectedCount) m
      , QueryResult (Qsimple SelectedCount) ~ Rsimple
      , Reflex t
@@ -186,6 +221,17 @@ displayPost postId = do
         Nothing -> text "Post Not Found"
         Just dPost -> dynText dPost
 
+-- To avoid requiring reflex-dom, we stub out a few functions that you'd normally get from reflex-dom-core.
+type Widget t m = (NotReady t m, Adjustable t m, PostBuild t m)
+
+dyn_ :: (NotReady t m, Adjustable t m, PostBuild t m) => Dynamic t (m a) -> m ()
+dyn_ = void . networkView
+
+text :: Monad m => Text -> m ()
+text _ = pure ()
+
+dynText :: Monad m => Dynamic t Text -> m ()
+dynText _ = pure ()
 ```
 
 We can try to improve the situation in essentially all of
@@ -239,6 +285,11 @@ boilerplate; there's a small amount of TH to derive GCompare and all of the
 remaining instances follow from the view types in vessel:
 
 ```haskell
+deriveArgDict ''Qvessel
+deriveJSONGADT ''Qvessel
+deriveGEq ''Qvessel
+deriveGCompare ''Qvessel
+deriveGShow ''Qvessel
 
 viewPost :: (MonadQuery t (Vessel Qvessel (Const SelectedCount)) m, Reflex t, Monad m)
   => Dynamic t PostId -> m (Dynamic t (Maybe (Maybe Post)))
@@ -255,19 +306,6 @@ other types "right".
 ***
 
 ```haskell
-
--- To avoid requiring reflex-dom, we stub out a few functions that you'd normally get from reflex-dom-core.
-type Widget t m = (NotReady t m, Adjustable t m, PostBuild t m)
-
-dyn_ :: (NotReady t m, Adjustable t m, PostBuild t m) => Dynamic t (m a) -> m ()
-dyn_ = void . networkView
-
-text :: Monad m => Text -> m ()
-text _ = pure ()
-
-dynText :: Monad m => Dynamic t Text -> m ()
-dynText _ = pure ()
-
 positive :: forall x. (Monoid x, Ord x) => x -> SelectedCount
 positive x
   | x > mempty = 1
@@ -319,47 +357,4 @@ readShowLatestPost = dischargeMonadQuery promtForIt displayLatestPost
     promtForIt q = liftIO $ do
       print q
       readLn
-
--- annoying stuff that needs to exist but doesn't.
-newtype GrpMap k v = GrpMap { unGrpMap :: Map k v } deriving (Eq, Ord, Show, Read)
-type role GrpMap nominal nominal
-
-liftNonZero :: (Monoid a, Eq a) => (a -> a -> a) -> a -> a -> Maybe a
-liftNonZero f x y = if (xy /= mempty)
-  then Just x
-  else Nothing
-  where xy = f x y
-
-instance (Monoid g, Eq g, Ord k) => Semigroup (GrpMap k g) where
-  GrpMap xs <> GrpMap ys = GrpMap $ Map.merge id id (Map.zipWithMaybeMatched $ const $ liftNonZero (<>)) xs ys
-
-instance (Monoid g, Eq g, Ord k) => Monoid (GrpMap k g) where
-  mempty = GrpMap Map.empty
-  mappend = (<>)
-
-instance (Group g, Eq g, Ord k) => Group (GrpMap k g) where
-  negateG (GrpMap xs) = GrpMap $ fmap negateG xs
-  GrpMap xs ~~ GrpMap ys = GrpMap $ Map.merge id (Map.mapMissing $ const $ negateG) (Map.zipWithMaybeMatched $ const $ liftNonZero (~~)) xs ys
-
-class (forall g. (Eq g, Group g) => Group (f g)) => GrpFunctor f where
-  mapG :: (Eq b, Group b) => (a -> b) -> f a -> f b
-
--- distributive functors can still be groups.
-instance GrpFunctor ((->) r) where mapG = fmap
-instance GrpFunctor Proxy where mapG = fmap
-instance GrpFunctor Identity where mapG = fmap
-
-instance Ord k => GrpFunctor (GrpMap k) where
-  mapG f (GrpMap xs) = GrpMap $ Map.mapMaybe (\x ->
-    let fx = f x
-    in if fx /= mempty
-    then Just fx
-    else Nothing) xs
-
-deriveArgDict ''Qvessel
-deriveJSONGADT ''Qvessel
-deriveGEq ''Qvessel
-deriveGCompare ''Qvessel
-deriveGShow ''Qvessel
-
 ```
diff --git a/vessel.cabal b/vessel.cabal
@@ -50,10 +50,10 @@ library
     UndecidableInstances
 
   build-depends:
-      aeson                        >=1.4     && <2.2
-    , base                         >=4.9     && <4.17
+      aeson                        >=1.4     && <2.3
+    , base                         >=4.9     && <4.20
     , base-orphans                 ^>=0.8.5
-    , bifunctors                   ^>=5.5
+    , bifunctors                   >=5.5     && <5.7
     , commutative-semigroups       ^>=0.1
     , constraints                  >=0.10    && <0.15
     , constraints-extras           ^>=0.4
@@ -63,11 +63,11 @@ library
     , dependent-sum                ^>=0.7
     , dependent-sum-aeson-orphans  ^>=0.3.1
     , monoidal-containers          ^>=0.6
-    , mtl                          ^>=2.2
+    , mtl                          >=2.2     && <2.4
     , patch                        ^>=0.0.7.0
     , reflex                       >=0.6.4   && <1
     , semialign                    >=1
-    , these                        >=1 && <1.2
+    , these                        >=1       && <1.3
     , witherable                   >=0.2 && <0.5
 
   hs-source-dirs:   src