Decorator-style handler

[emlautarom1]

I'm trying to get the following code to compile:

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Main where

import Control.Monad
import Effectful
import Effectful.Dispatch.Dynamic
import System.IO
import Prelude hiding (log)

data Severity = Info | Error | Fatal
  deriving (Show, Eq, Ord, Bounded)

data Logger e :: Effect where
  Log :: Severity -> String -> (Logger e) m ()

type instance DispatchOf (Logger e) = Dynamic

log :: (Logger e :> es) => Severity -> String -> Eff es ()
log severity message = send $ Log severity message

runNoLogger :: Eff (Logger e : es) a -> Eff es a
runNoLogger = interpret $ \_ -> \case
  Log _ _ -> return ()

runLoggerAbove :: (Logger e :> es) => Severity -> Eff (Logger e : es) a -> Eff es a
runLoggerAbove minSeverity = interpret $ \_ -> \case
  Log severity message -> do
    when (severity >= minSeverity) $ do
      log severity message

runHandleLogger :: (IOE :> es) => Handle -> Eff (Logger e : es) a -> Eff es a
runHandleLogger handle = interpret $ \_ -> \case
  Log severity message -> do
    liftIO $ hPutStrLn handle (prefix severity ++ " " ++ message)

prefix :: Severity -> String
prefix = \case
  Info -> "[INFO]"
  Error -> "[ERROR]"
  Fatal -> "[FATAL]"

program :: (Logger e :> es) => Eff es ()
program = do
  log Info "Hello, world!"
  log Error "Something went wrong!"
  log Fatal "Everything is on fire!"

main :: IO ()
main = do
  withFile "example.log" WriteMode $ \h ->
    runEff $ runHandleLogger h $ runLoggerAbove Info $ do
      program

The idea is that we have a single effect Logger which accepts multiple interpretations, for example, we might have a logger that does not log anything (runNoLogger) or a logger which writes to a file (runHandleLogger).

Now, I would like to have a "handler" that works like a Decorator, that is, the "handler" requires another "handler" that actually does the work, but before (or after) this "inner" handle takes control the Decorator performs some kind of (pre/post)processing. In this case, I would like to have a decorator runLoggerAbove that when the severity is some value it delegates the work to "inner", otherwise it does nothing (return ()).

The code above does not compile with the following error:

app/Main.hs:58:7: error: [GHC-43085]
    * Overlapping instances for Logger e0
                                :> [Logger e1, Logger e1, IOE]
        arising from a use of `program'
      Matching instance:
        instance (e :> es) => e :> (x : es)
          -- Defined in `Effectful.Internal.Effect'
      Potentially matching instance:
        instance [overlapping] e :> (e : es)
          -- Defined in `Effectful.Internal.Effect'
      (The choice depends on the instantiation of `e0, e1'
       To pick the first instance above, use IncoherentInstances
       when compiling the other instance declarations)
    * In a stmt of a 'do' block: program
      In the second argument of `($)', namely `do program'
      In the second argument of `($)', namely
        `runLoggerAbove Info $ do program'
   |
58 |       program
   |       ^^^^^^^

My .cabal file looks like this:

cabal-version:   3.0
name:            EffectfulPlayground
version:         0.1.0.0
license:         NONE
author:          Lautaro Emanuel
maintainer:      emlautarom1@gmail.com
build-type:      Simple
extra-doc-files: CHANGELOG.md

common warnings
    ghc-options: -Wall

executable EffectfulPlayground
    import:           warnings
    main-is:          Main.hs
    build-depends:    base < 5.0
                    , effectful
                    , effectful-core
                    , effectful-plugin
    hs-source-dirs:   app
    default-language: Haskell2010
    ghc-options:      -fplugin=Effectful.Plugin

My environment:

$ cabal --version
cabal-install version 3.12.1.0
compiled using version 3.12.1.0 of the Cabal library 
$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 9.6.6

[emlautarom1]

In a more generic fashion, the runLoggerAbove ideally would look like:

runLoggerAbove severity impl1 impl2 = interpret $ \_ -> \case
  Log severity message -> do
    if severity >= minSeverity then do
      -- use `impl1` as handler
    else do
      -- use `impl2` as handler