Drop GHC8 from CI and update GHC9 versions in CI.

.github/workflows/cabal.yml

@@ -34,7 +34,7 @@ jobs:
     strategy:
       matrix:
         cabal: ["3.6"]
-        ghc: ["8.10.7", "9.0.2", "9.2.4"]
+        ghc: ["9.2.8", "9.4.8", "9.6.3"]
 
     env:
       CONFIG: "--project-file=cabal.project"
@@ -52,7 +52,7 @@ jobs:
 
       - name: Freeze
         run: |
-          cabal configure --enable-tests --test-show-details=direct
+          cabal configure --enable-tests --test-show-details=direct $CONFIG
           cabal freeze
 
       - name: Cache

cabal.project

@@ -5,7 +5,7 @@ packages: cofree-bot
 source-repository-package
   type: git
   location: https://github.com/softwarefactory-project/matrix-client-haskell.git
-  tag: c21adc380746b4763829af993da6a844c3907530
+  tag: fb12649c8d8894dc19216301285c9888d0058c0f
   subdir: matrix-client
 
 source-repository-package

chat-bots-contrib/src/Data/Chat/Server/Matrix.hs

@@ -11,7 +11,9 @@ where
 --------------------------------------------------------------------------------
 
 import Control.Lens
+import Control.Monad (zipWithM_)
 import Control.Monad.Except
+import Control.Monad.IO.Class (MonadIO (..))
 import Data.Chat.Bot
 import Data.Chat.Bot.Serialization
 import Data.Chat.Server
@@ -87,7 +89,7 @@ matrix session cache = Server $ do
           -- Do it again
           runServer $ go filterId (Just newSince)
 
-embedTextBot :: Applicative m => Bot m s Text Text -> Bot m s (RoomID, Event) (RoomID, Event)
+embedTextBot :: (Applicative m) => Bot m s Text Text -> Bot m s (RoomID, Event) (RoomID, Event)
 embedTextBot = second' . flip applySerializer eventSerializer
 
 eventSerializer :: Serializer Event Event Text Text

chat-bots-contrib/test/TestServer.hs

@@ -13,10 +13,10 @@ where
 
 import Control.Monad.Except
   ( MonadError (..),
-    MonadTrans (..),
     liftEither,
     runExceptT,
   )
+import Control.Monad.Trans (MonadTrans (..))
 import Data.Chat.Bot (Behavior, hoistBehavior)
 import Data.Chat.Server
   ( Env (..),
@@ -69,7 +69,7 @@ conformsToScript' behavior script = do
   fmap onlyLeft $ runExceptT $ bindFix $ annihilate server (hoistBehavior lift behavior)
   where
     -- TODO: move these somewhere else
-    bindFix :: Monad m => Fix m -> m Void
+    bindFix :: (Monad m) => Fix m -> m Void
     bindFix (Fix m) = m >>= bindFix
 
     onlyLeft :: Either a Void -> a

chat-bots/src/Control/Monad/ListT.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE QuantifiedConstraints #-}
@@ -26,7 +27,13 @@ where
 
 import Control.Applicative (Alternative (..), Applicative (..))
 import Control.Monad (ap)
+#if MIN_VERSION_base(4,18,0)
+import Control.Monad.Except (MonadError (..))
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Trans (MonadTrans (..))
+#else
 import Control.Monad.Except (MonadError (..), MonadIO (..), MonadTrans (..))
+#endif
 import Data.Align
 import Data.Bifunctor (Bifunctor (..))
 import Data.Foldable (Foldable (..))
@@ -57,25 +64,25 @@ deriving instance (Eq (m (ListF a (ListT m a))), Eq1 m, Eq a) => Eq (ListT m a)
 
 deriving instance (Show (m (ListF a (ListT m a))), Show1 m, Show a) => Show (ListT m a)
 
-instance Functor m => Functor (ListT m) where
+instance (Functor m) => Functor (ListT m) where
   fmap :: (a -> b) -> ListT m a -> ListT m b
   fmap f (ListT ma) = ListT $ fmap (bimap f (fmap f)) $ ma
 
-instance Monad m => Applicative (ListT m) where
-  pure :: Monad m => a -> ListT m a
+instance (Monad m) => Applicative (ListT m) where
+  pure :: (Monad m) => a -> ListT m a
   pure = ListT . return . (`ConsF` emptyListT)
 
-  (<*>) :: Monad m => ListT m (a -> b) -> ListT m a -> ListT m b
+  (<*>) :: (Monad m) => ListT m (a -> b) -> ListT m a -> ListT m b
   (<*>) = ap
 
-instance Monad m => Alternative (ListT m) where
+instance (Monad m) => Alternative (ListT m) where
   empty :: ListT m a
   empty = nil
 
   (<|>) :: ListT m a -> ListT m a -> ListT m a
   xs <|> ys = appendListT xs ys
 
-instance Applicative m => Semialign (ListT m) where
+instance (Applicative m) => Semialign (ListT m) where
   align :: ListT m a -> ListT m b -> ListT m (These a b)
   align (ListT m) (ListT n) =
     ListT $
@@ -85,7 +92,7 @@ instance Applicative m => Semialign (ListT m) where
         (NilF, ConsF y' ys) -> ConsF (That y') (fmap That ys)
         (ConsF x' xs, ConsF y' ys) -> ConsF (These x' y') (align xs ys)
 
-instance Applicative m => Align (ListT m) where
+instance (Applicative m) => Align (ListT m) where
   nil :: ListT m a
   nil = ListT $ pure NilF
 
@@ -99,25 +106,25 @@ deriving via Functor.FromAlternative (ListT m) instance (Monad m) => Functor.Uni
 
 deriving via Functor.FromSemialign (ListT m) instance (Monad m) => Functor.Semigroupal (->) These (,) (ListT m)
 
-instance Monad m => Functor.Monoidal (->) (,) () (,) () (ListT m)
+instance (Monad m) => Functor.Monoidal (->) (,) () (,) () (ListT m)
 
-instance Monad m => Functor.Monoidal (->) Either Void (,) () (ListT m)
+instance (Monad m) => Functor.Monoidal (->) Either Void (,) () (ListT m)
 
-instance Monad m => Functor.Monoidal (->) These Void (,) () (ListT m)
+instance (Monad m) => Functor.Monoidal (->) These Void (,) () (ListT m)
 
-instance Monad m => Monad (ListT m) where
+instance (Monad m) => Monad (ListT m) where
   (>>=) :: ListT m a -> (a -> ListT m b) -> ListT m b
   ma >>= amb = joinListT $ fmap amb ma
 
 instance MonadTrans ListT where
-  lift :: Monad m => m a -> ListT m a
+  lift :: (Monad m) => m a -> ListT m a
   lift ma = ListT $ fmap (\a -> ConsF a (ListT $ pure NilF)) ma
 
-instance MonadIO m => MonadIO (ListT m) where
+instance (MonadIO m) => MonadIO (ListT m) where
   liftIO :: IO a -> ListT m a
   liftIO io = ListT $ liftIO $ fmap (\a -> ConsF a (ListT $ pure NilF)) io
 
-instance MonadError e m => MonadError e (ListT m) where
+instance (MonadError e m) => MonadError e (ListT m) where
   throwError :: e -> ListT m a
   throwError = lift . throwError
 
@@ -142,28 +149,28 @@ instance Bifunctor ListF where
 --------------------------------------------------------------------------------
 
 -- | The empty 'ListT'.
-emptyListT :: Applicative m => ListT m a
+emptyListT :: (Applicative m) => ListT m a
 emptyListT = nil
 
 -- | A 'ListT' of one element.
-singletonListT :: Applicative m => a -> ListT m a
+singletonListT :: (Applicative m) => a -> ListT m a
 singletonListT a = consListT a emptyListT
 
 -- | Consing a value to a 'LisT'.
-consListT :: Applicative m => a -> ListT m a -> ListT m a
+consListT :: (Applicative m) => a -> ListT m a -> ListT m a
 consListT a = \case
   ListT ml ->
     ListT $
       ml <&> \case
         NilF -> ConsF a emptyListT
         ConsF x xs -> ConsF a $ ListT $ pure $ ConsF x xs
 
-appendListT :: Monad m => ListT m a -> ListT m a -> ListT m a
+appendListT :: (Monad m) => ListT m a -> ListT m a -> ListT m a
 appendListT (ListT xs) ys = ListT $ do
   xs' <- xs
   runListT $ appendListF xs' ys
 
-appendListF :: Monad m => ListF a (ListT m a) -> ListT m a -> ListT m a
+appendListF :: (Monad m) => ListF a (ListT m a) -> ListT m a -> ListT m a
 appendListF NilF ys = ys
 appendListF (ConsF x xs) ys = ListT $ pure $ ConsF x $ appendListT xs ys
 
@@ -172,14 +179,14 @@ toListT :: (Foldable t, Applicative m) => t a -> ListT m a
 toListT = foldr' consListT emptyListT
 
 -- | Convert a 'ListT' into a '[]' and sequence the effects.
-fromListT :: Monad m => ListT m a -> m [a]
+fromListT :: (Monad m) => ListT m a -> m [a]
 fromListT (ListT m) =
   m >>= \case
     NilF -> pure []
     ConsF a xs -> fmap (a :) $ fromListT xs
 
 -- | The join operation of the 'ListT' @m@ monad.
-joinListT :: Monad m => ListT m (ListT m a) -> ListT m a
+joinListT :: (Monad m) => ListT m (ListT m a) -> ListT m a
 joinListT (ListT ma) = ListT $ do
   fma <- ma
   case fma of
@@ -192,5 +199,5 @@ joinListT (ListT ma) = ListT $ do
 
 -- | Lift a monad morphism from @m@ to @n@ into a monad morphism from
 -- @ListT m@ to @ListT n@.
-hoistListT :: Functor n => (forall x. m x -> n x) -> ListT m a -> ListT n a
+hoistListT :: (Functor n) => (forall x. m x -> n x) -> ListT m a -> ListT n a
 hoistListT f = ListT . fmap (fmap (hoistListT f)) . f . runListT

chat-bots/src/Data/Chat/Bot.hs

@@ -33,10 +33,11 @@ where
 
 --------------------------------------------------------------------------------
 
-import Control.Monad.Except (MonadIO (..), MonadTrans (..))
+import Control.Monad.IO.Class (MonadIO (..))
 import Control.Monad.ListT (ListF (..), ListT (..), emptyListT, hoistListT)
 import Control.Monad.Reader (MonadReader, ReaderT (..))
 import Control.Monad.State (MonadState, StateT (..))
+import Control.Monad.Trans (MonadTrans (..))
 import Data.Align
 import Data.Bifunctor (Bifunctor (..))
 import Data.Bifunctor.Monoidal qualified as Bifunctor
@@ -90,18 +91,18 @@ newtype Bot m s i o = Bot {runBot :: s -> i -> ListT m (o, s)}
     (Functor, Applicative, Monad, MonadState s, MonadReader i, MonadIO)
     via StateT s (ReaderT i (ListT m))
 
-instance Monad m => Trifunctor.Semigroupal (->) (,) (,) (,) (,) (Bot m) where
+instance (Monad m) => Trifunctor.Semigroupal (->) (,) (,) (,) (,) (Bot m) where
   combine :: (Bot m s i o, Bot m t i' o') -> Bot m (s, t) (i, i') (o, o')
   combine (Bot b1, Bot b2) = Bot $ \(s, t) (i, i') ->
     liftA2 (curry (\((o, s'), (o', t')) -> ((o, o'), (s', t')))) (b1 s i) (b2 t i')
 
-instance Functor m => Trifunctor.Semigroupal (->) (,) Either Either (,) (Bot m) where
+instance (Functor m) => Trifunctor.Semigroupal (->) (,) Either Either (,) (Bot m) where
   combine :: (Bot m s i o, Bot m t i' o') -> Bot m (s, t) (Either i i') (Either o o')
   combine (Bot m1, Bot m2) = Bot $ \(s, t) -> \case
     Left i -> (bimap Left (,t) <$> m1 s i)
     Right i' -> bimap Right (s,) <$> m2 t i'
 
-instance Monad m => Trifunctor.Semigroupal (->) (,) These These (,) (Bot m) where
+instance (Monad m) => Trifunctor.Semigroupal (->) (,) These These (,) (Bot m) where
   combine :: (Bot m s i o, Bot m t i' o') -> Bot m (s, t) (These i i') (These o o')
   combine (Bot b1, Bot b2) = Bot $ \(s, t) -> \case
     This i -> bimap This (,t) <$> b1 s i
@@ -126,51 +127,51 @@ instance (Applicative m) => Trifunctor.Monoidal (->) (,) () Either Void Either V
 
 instance (Monad m) => Trifunctor.Monoidal (->) (,) () These Void These Void (,) () (Bot m)
 
-instance Functor f => Profunctor (Bot f s) where
-  dimap :: Functor f => (a -> b) -> (c -> d) -> Bot f s b c -> Bot f s a d
+instance (Functor f) => Profunctor (Bot f s) where
+  dimap :: (Functor f) => (a -> b) -> (c -> d) -> Bot f s b c -> Bot f s a d
   dimap f g (Bot bot) = do
     Bot $ \s i -> fmap (first' g) $ bot s (f i)
 
-instance Functor f => Strong (Bot f s) where
-  first' :: Functor f => Bot f s a b -> Bot f s (a, c) (b, c)
+instance (Functor f) => Strong (Bot f s) where
+  first' :: (Functor f) => Bot f s a b -> Bot f s (a, c) (b, c)
   first' (Bot bot) = Bot $ \s (a, c) -> fmap (first' (,c)) $ bot s a
 
 -- | 'Bot' is an invariant functor on @s@ but our types don't quite
 -- fit the @Invariant@ typeclass.
-invmapBot :: Functor m => (s -> s') -> (s' -> s) -> Bot m s i o -> Bot m s' i o
+invmapBot :: (Functor m) => (s -> s') -> (s' -> s) -> Bot m s i o -> Bot m s' i o
 invmapBot f g (Bot b) = Bot $ \s i -> (b (g s) i) <&> bimap id f
 
 --------------------------------------------------------------------------------
 
 -- | Lift the 'ListT' Nil value into @Bot m s i o@.
-emptyBot :: Monad m => Bot m s i o
+emptyBot :: (Monad m) => Bot m s i o
 emptyBot = Bot $ \_ _ -> emptyListT
 
 -- | Construct a 'Bot' which maps from @i@ to @o@ without using its
 -- state @s@ or monadic action @m@.
-pureStatelessBot :: Monad m => (i -> o) -> Bot m s i o
+pureStatelessBot :: (Monad m) => (i -> o) -> Bot m s i o
 pureStatelessBot f = Bot $ \s i -> pure $ (,) (f i) s
 
 -- | Contramap the input to a bot with the ability to fail and only
 -- run the bot on success.
-contramapMaybeBot :: Applicative m => (i -> Maybe i') -> Bot m s i' o -> Bot m s i o
+contramapMaybeBot :: (Applicative m) => (i -> Maybe i') -> Bot m s i' o -> Bot m s i o
 contramapMaybeBot f (Bot bot) = Bot $ \s i -> maybe emptyListT (bot s) (f i)
 
 -- | Lift a monad morphism from @m@ to @n@ into a monad morphism from
 -- @Bot m s i o@ to @Bot n s i o@
-hoistBot :: Functor n => (forall x. m x -> n x) -> Bot m s i o -> Bot n s i o
+hoistBot :: (Functor n) => (forall x. m x -> n x) -> Bot m s i o -> Bot n s i o
 hoistBot f (Bot b) = Bot $ \s i -> hoistListT f $ b s i
 
 -- | Lift a monadic effect @m o@ into a @Bot m s i o@.
-liftEffect :: Monad m => m o -> Bot m s i o
+liftEffect :: (Monad m) => m o -> Bot m s i o
 liftEffect m = Bot $ \s _ -> ListT $ do
   o <- m
   pure $ ConsF (o, s) (ListT $ pure NilF)
 
 -- | Generate the fixed point of @Bot m s i o@ by recursively
 -- construction an @s -> Behavior m i o@ action and tupling it with
 -- the output @o@ from its parent action.
-fixBot :: forall m s i o. Functor m => Bot m s i o -> s -> Behavior m i o
+fixBot :: forall m s i o. (Functor m) => Bot m s i o -> s -> Behavior m i o
 fixBot (Bot b) = go
   where
     go :: s -> Behavior m i o
@@ -194,12 +195,12 @@ fixBotPersistent cachePath (Bot bot) initialState = do
           liftIO $ saveState cachePath newState
           pure (output, go)
 
-readState :: Read s => FilePath -> IO (Maybe s)
+readState :: (Read s) => FilePath -> IO (Maybe s)
 readState cachePath = do
   s <- readFileMaybe $ cachePath </> "state"
   pure $ fmap (read . Text.unpack) s
 
-saveState :: Show s => FilePath -> s -> IO ()
+saveState :: (Show s) => FilePath -> s -> IO ()
 saveState cachePath state' = do
   createDirectoryIfMissing True cachePath
   writeFile (cachePath </> "state") (show state')
@@ -214,8 +215,8 @@ saveState cachePath state' = do
 -- See 'annihilate' for how this interaction occurs in practice.
 newtype Behavior m i o = Behavior {runBehavior :: i -> ListT m (o, (Behavior m i o))}
 
-instance Functor m => Profunctor (Behavior m) where
-  dimap :: Functor m => (a -> b) -> (c -> d) -> Behavior m b c -> Behavior m a d
+instance (Functor m) => Profunctor (Behavior m) where
+  dimap :: (Functor m) => (a -> b) -> (c -> d) -> Behavior m b c -> Behavior m a d
   dimap f g (Behavior b) = Behavior $ dimap f (fmap (bimap g (dimap f g))) b
 
 instance (Monad m) => Bifunctor.Semigroupal (->) (,) (,) (,) (Behavior m) where
@@ -229,19 +230,19 @@ instance (Monad m) => Bifunctor.Unital (->) () () () (Behavior m) where
 
 instance (Monad m) => Bifunctor.Monoidal (->) (,) () (,) () (,) () (Behavior m)
 
-instance Monad m => Choice (Behavior m) where
-  left' :: Monad m => Behavior m a b -> Behavior m (Either a c) (Either b c)
+instance (Monad m) => Choice (Behavior m) where
+  left' :: (Monad m) => Behavior m a b -> Behavior m (Either a c) (Either b c)
   left' (Behavior b) =
     Behavior $
       either
         (fmap (bimap Left left') . b)
         (pure . (,left' (Behavior b)) . Right)
 
-instance Functor m => Strong (Behavior m) where
-  first' :: Functor m => Behavior m a b -> Behavior m (a, c) (b, c)
+instance (Functor m) => Strong (Behavior m) where
+  first' :: (Functor m) => Behavior m a b -> Behavior m (a, c) (b, c)
   first' (Behavior b) = Behavior $ \(a, c) -> fmap (bimap (,c) first') (b a)
 
-instance Monad m => Traversing (Behavior m) where
+instance (Monad m) => Traversing (Behavior m) where
   -- TODO: write wander instead for efficiency
   traverse' :: (Monad m, Traversable f) => Behavior m a b -> Behavior m (f a) (f b)
   traverse' b = Behavior $ \is ->
@@ -257,7 +258,7 @@ instance Monad m => Traversing (Behavior m) where
 
 -- | Batch process a list of inputs @i@ with a single 'Behavior',
 -- interleaving the effects, and collecting the resulting outputs @o@.
-batch :: Monad m => Behavior m i o -> Behavior m [i] o
+batch :: (Monad m) => Behavior m i o -> Behavior m [i] o
 batch (Behavior b) = Behavior $ fmap (fmap batch) . asum . fmap b
 
 -- | Lift a monad morphism from @m@ to @n@ into a monad morphism from