Правила перезаписи GHC с ограничениями класса

Я добавил следующее правило перезаписи в канал без проблем:

{-# RULES "ConduitM: lift x >>= f" forall m f.
    lift m >>= f = ConduitM (PipeM (liftM (unConduitM . f) m))
  #-}

Я пытаюсь добавить аналогичные правила перезаписи для liftIO, а также

{-# RULES "ConduitM: liftIO x >>= f" forall m f.
    liftIO m >>= f = ConduitM (PipeM (liftM (unConduitM . f) (liftIO m)))
  #-}

Однако, когда я пытаюсь сделать это, я получаю следующие сообщения об ошибках от GHC:

Data/Conduit/Internal/Conduit.hs:1025:84:
    Could not deduce (Monad m) arising from a use of ‘liftM’
    from the context (Monad (ConduitM i o m), MonadIO (ConduitM i o m))
      bound by the RULE "ConduitM: liftIO x >>= f"
      at Data/Conduit/Internal/Conduit.hs:1025:11-118
    Possible fix:
      add (Monad m) to the context of the RULE "ConduitM: liftIO x >>= f"
    In the first argument of ‘PipeM’, namely
      ‘(liftM (unConduitM . f) (liftIO m))’
    In the first argument of ‘ConduitM’, namely
      ‘(PipeM (liftM (unConduitM . f) (liftIO m)))’
    In the expression:
      ConduitM (PipeM (liftM (unConduitM . f) (liftIO m)))

Data/Conduit/Internal/Conduit.hs:1025:108:
    Could not deduce (MonadIO m) arising from a use of ‘liftIO’
    from the context (Monad (ConduitM i o m), MonadIO (ConduitM i o m))
      bound by the RULE "ConduitM: liftIO x >>= f"
      at Data/Conduit/Internal/Conduit.hs:1025:11-118
    Possible fix:
      add (MonadIO m) to the context of
        the RULE "ConduitM: liftIO x >>= f"
    In the second argument of ‘liftM’, namely ‘(liftIO m)’
    In the first argument of ‘PipeM’, namely
      ‘(liftM (unConduitM . f) (liftIO m))’
    In the first argument of ‘ConduitM’, namely
      ‘(PipeM (liftM (unConduitM . f) (liftIO m)))’

Я не знаю ни одного синтаксиса, который позволил бы мне указать такой контекст на правило перезаписи. Есть ли способ достичь этого?

Ответы

{-# RULES "ConduitM: liftIO x >>= f" forall m (f :: (Monad n, MonadIO n) => CounduitM i o n r).
    liftIO m >>= f = ConduitM (PipeM (liftM (unConduitM . f) (liftIO m)))
  #-}

#!/usr/bin/env stack
-- stack --resolver lts-7.14 exec -- ghc -O -ddump-rule-firings
module Main where

import Prelude as P
import System.Environment (getArgs)


class Num e => Power e where
  (^:) :: Integral a => e -> a -> e

instance Power Double where
  (^:) x y = go 0 1 where
    go n acc | n < y = go (n+1) (acc*x)
             | n > y = go (n-1) (acc/x)
             | otherwise = acc

main :: IO ()
main = do
  [xStr] <- getArgs
  let x = read xStr :: Double
  print (x ^ 24)

{-# RULES
 "1. Test ^" forall (x :: Power x => x) n. x ^ n = x ^: n;
 "2. Test ^" forall x n. (x :: Double) ^ n = x ^: n 
 #-}