Обобщить подвеску Coroutine

Question

Я пытаюсь разобраться и иметь сопрограмму, которая собирается запросить все действия IO извне. Поэтому у меня есть мой пользовательский тип подвески IORequest. Проблема в том, что для каждого типа возвращаемого типа мне нужно добавить дополнительный конструктор в IORequest.

Вот рабочий пример (который требует mtl и monad-coroutine)

{-# LANGUAGE DeriveFunctor #-} 
module Main where 

import Control.Monad.State 
import Control.Monad.Coroutine 

main :: IO() 
main = loop coroutine initialState 

initialState :: Int 
initialState = 65432 

data IORequest x 
    = RunIO (IO()) (() -> x) 
    | GetString (IO String) (String -> x) 
    deriving Functor 

request :: Monad m => IO() -> Coroutine IORequest m() 
request x = suspend (RunIO x return) 

requestString :: Monad m => IO String -> Coroutine IORequest m String 
requestString x = suspend (GetString x return) 

coroutine :: Coroutine IORequest (State Int) Int 
coroutine = do 
    str <- requestString (readFile "my.txt") 
    request (print "hello") 
    return 5 

loop :: Coroutine IORequest (State Int) Int -> Int -> IO() 
loop routine state = 
    do let (request, state') = runState (resume routine) state 
    case request of 
     Left (GetString cmd q') -> do 
     str <- cmd 
     loop (q' str) state' 
     Left (RunIO cmd q') -> do 
     cmd 
     loop (q'()) state' 
     Right result -> do 
     print result 

Как вы можете видеть, если в какой-то момент мне нужно запустить действие IO Bool мне нужно будет продлить IORequest и обеспечить еще один вспомогательный метод для быть в состоянии успешно использовать его (а также расширять совпадение рисунка в loop).

Вопрос: может ли IORequest быть обобщенным как-то разрешить общий (IO a) -> a переход?

Что-то вроде

data IORequest x 
    = forall a. RunIO (IO a) (a -> x) 

(я не смог заставить его работать, хотя, как a бы избежать, если мы попытаемся запустить его в str <- cmd, например)

Answer 1

Ваш комментарий об изменении типа данных чтобы содержать квантор существования, кажется вполне разумным. Большинство ваших функций не меняются.

data IORequest x = forall a . RunIO (IO a) (a -> x) 

instance Functor IORequest where 
    fmap f (RunIO x g) = RunIO x (f.g) 

Замените другие конструкторы с RunIO:

request :: Monad m => IO() -> Coroutine IORequest m() 
request x = suspend (RunIO x return) 

requestString :: Monad m => IO String -> Coroutine IORequest m String 
requestString x = suspend (RunIO x return) 

И ваша функция петли не меняет либо - вам просто нужно не игнорировать значение внутри RunIO:

loop :: Coroutine IORequest (State Int) Int -> Int -> IO() 
loop routine state = 
    do let (request, state') = runState (resume routine) state 
    case request of 
     Left (RunIO cmd q') -> do 
     a <- cmd 
     loop (q' a) state' 
     Right result -> do 
     print result 

Обратите внимание, что ваш IORequest также может быть определен таким образом (если у вас есть достаточно прием нт GHC):

{-# LANGUAGE PatternSynonyms, ViewPatterns #-} 

import Data.Functor.Kan.Lan (Lan(..)) 
import Data.Functor.Identity (Identity(..)) 

type IORequest = Lan Identity IO 

pattern RunIO :: IO a -> (a -> x) -> IORequest x 
pattern RunIO x f <- Lan ((.Identity) -> f) x 
    where RunIO x f = Lan (f.runIdentity) x 

Тогда ясно видно, что IORequest теперь просто изоморфно IO. Это вытекает из законов левого кан расширения (а именно, что lanToComposedAdjoint и composedAdjointToLan являются свидетельством изоморфизма), но могут быть записаны непосредственно:

actuallyJustIO_1 :: IORequest a -> IO a 
actuallyJustIO_1 = fmap runIdentity . lanToComposedAdjoint 

actuallyJustIO_2 :: IO a -> IORequest a 
actuallyJustIO_2 = composedAdjointToLan . fmap Identity 

Эти две функции четко левый и правый обратный друг друга, свидетельствуя изоморфизм между IORequest и IO.