Bump semantic-core to fused-effects-0.5.

semantic-core/semantic-core.cabal

@@ -41,7 +41,7 @@ library
                      , containers                  ^>= 0.6
                      , directory                   ^>= 1.3
                      , filepath                    ^>= 1.4
-                     , fused-effects               ^>= 0.4
+                     , fused-effects               ^>= 0.5
                      , haskeline                   ^>= 0.7.5
                      , parsers                     ^>= 0.12.10
                      , prettyprinter               ^>= 1.2.1

semantic-core/src/Analysis/Eval.hs

@@ -11,7 +11,6 @@ module Analysis.Eval
 , Analysis(..)
 ) where
 
-import Control.Effect
 import Control.Effect.Fail
 import Control.Effect.Reader
 import Control.Monad ((>=>))

semantic-core/src/Control/Effect/Readline.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, OverloadedStrings, RankNTypes, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, OverloadedStrings, RankNTypes, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
 
 module Control.Effect.Readline
 ( Readline (..)
@@ -20,37 +20,32 @@ import Prelude hiding (print)
 
 import Control.Effect.Carrier
 import Control.Effect.Reader
-import Control.Effect.Sum
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
-import Data.Coerce
 import Data.Int
 import Data.String
 import Data.Text.Prettyprint.Doc
 import Data.Text.Prettyprint.Doc.Render.Text
+import GHC.Generics (Generic1)
 import System.Console.Haskeline hiding (Handler, handle)
 import System.Directory
 import System.FilePath
 
-data Readline (m :: * -> *) k
-  = Prompt String (Maybe String -> k)
-  | forall a . Print (Doc a) k
-  | AskLine (Line -> k)
+data Readline m k
+  = Prompt String (Maybe String -> m k)
+  | Print AnyDoc (m k)
+  | AskLine (Line -> m k)
+  deriving stock (Functor, Generic1)
+  deriving anyclass (Effect, HFunctor)
 
-deriving instance Functor (Readline m)
-
-instance HFunctor Readline where
-  hmap _ = coerce
-
-instance Effect Readline where
-  handle state handler = coerce . fmap (handler . (<$ state))
+newtype AnyDoc = AnyDoc { unAnyDoc :: forall a . Doc a }
 
 prompt :: (IsString str, Member Readline sig, Carrier sig m) => String -> m (Maybe str)
 prompt p = fmap fromString <$> send (Prompt p pure)
 
 print :: (Pretty a, Carrier sig m, Member Readline sig) => a -> m ()
-print s = send (Print (pretty s) (pure ()))
+print s = send (Print (AnyDoc (pretty s)) (pure ()))
 
 println :: (Pretty a, Carrier sig m, Member Readline sig) => a -> m ()
 println s = print s >> print @String "\n"
@@ -64,7 +59,7 @@ increment :: Line -> Line
 increment (Line n) = Line (n + 1)
 
 newtype ReadlineC m a = ReadlineC { runReadlineC :: ReaderC Line (TransC InputT m) a }
-  deriving (Applicative, Functor, Monad, MonadIO)
+  deriving newtype (Applicative, Functor, Monad, MonadIO)
 
 runReadline :: MonadException m => Prefs -> Settings m -> ReadlineC m a -> m a
 runReadline prefs settings = runInputTWithPrefs prefs settings . runTransC . runReader (Line 0) . runReadlineC
@@ -75,7 +70,7 @@ instance (Carrier sig m, Effect sig, MonadException m, MonadIO m) => Carrier (Re
     local increment (runReadlineC (k str))
     where cyan = "\ESC[1;36m\STX"
           plain = "\ESC[0m\STX"
-  eff (L (Print text k)) = liftIO (putDoc text) *> k
+  eff (L (Print text k)) = liftIO (putDoc (unAnyDoc text)) *> k
   eff (L (AskLine k)) = ReadlineC ask >>= k
   eff (R other) = ReadlineC (eff (R (handleCoercible other)))
 
@@ -95,7 +90,7 @@ runReadlineWithHistory block = do
 
 -- | Promote a monad transformer into an effect.
 newtype TransC t (m :: * -> *) a = TransC { runTransC :: t m a }
-  deriving (Applicative, Functor, Monad, MonadIO, MonadTrans)
+  deriving newtype (Applicative, Functor, Monad, MonadIO, MonadTrans)
 
 instance (Carrier sig m, Effect sig, Monad (t m), MonadTrans t) => Carrier sig (TransC t m) where
   eff = TransC . join . lift . eff . handle (pure ()) (pure . (runTransC =<<))
@@ -105,7 +100,7 @@ runControlIO handler = runReader (Handler handler) . runControlIOC
 
 -- | This exists to work around the 'MonadException' constraint that haskeline entails.
 newtype ControlIOC m a = ControlIOC { runControlIOC :: ReaderC (Handler m) m a }
-  deriving (Applicative, Functor, Monad, MonadIO)
+  deriving newtype (Applicative, Functor, Monad, MonadIO)
 
 newtype Handler m = Handler (forall x . m x -> IO x)
 

semantic-core/src/Data/Core/Pretty.hs

@@ -8,7 +8,6 @@ module Data.Core.Pretty
   , prettyCore
   ) where
 
-import           Control.Effect
 import           Control.Effect.Reader
 import           Data.Core
 import           Data.File

semantic-core/src/Data/Loc.hs

@@ -15,7 +15,6 @@ import Control.Effect.Carrier
 import Control.Effect.Error
 import Control.Effect.Fail
 import Control.Effect.Reader
-import Control.Effect.Sum
 import Data.Text (Text, pack)
 import Data.Text.Prettyprint.Doc (Pretty (..))
 import GHC.Stack

semantic-core/src/Data/Name.hs

@@ -22,11 +22,9 @@ module Data.Name
 ) where
 
 import           Control.Applicative
-import           Control.Effect
 import           Control.Effect.Carrier
 import           Control.Effect.Reader
 import           Control.Effect.State
-import           Control.Effect.Sum
 import           Control.Monad.Fail
 import           Control.Monad.IO.Class
 import qualified Data.Char as Char
@@ -128,14 +126,14 @@ namespace s m = send (Namespace s m pure)
 
 
 data Naming m k
-  = Gensym Text (Gensym -> k)
-  | forall a . Namespace Text (m a) (a -> k)
+  = Gensym Text (Gensym -> m k)
+  | forall a . Namespace Text (m a) (a -> m k)
 
-deriving instance Functor (Naming m)
+deriving instance Functor m => Functor (Naming m)
 
 instance HFunctor Naming where
-  hmap _ (Gensym    s   k) = Gensym    s       k
-  hmap f (Namespace s m k) = Namespace s (f m) k
+  hmap f (Gensym    s   k) = Gensym    s       (f . k)
+  hmap f (Namespace s m k) = Namespace s (f m) (f . k)
 
 instance Effect Naming where
   handle state handler (Gensym    s   k) = Gensym    s                        (handler . (<$ state) . k)

semantic.cabal

@@ -55,8 +55,8 @@ common dependencies
                      , fastsum ^>= 0.1.1.0
                      , filepath ^>= 1.4.2.1
                      , free ^>= 5.1
-                     , fused-effects ^>= 0.4.0.0
                      , fused-effects-exceptions ^>= 0.1.1.0
+                     , fused-effects ^>= 0.5
                      , hashable ^>= 1.2.7.0
                      , tree-sitter ^>= 0.1.0.0
                      , mtl ^>= 2.2.2