Как я могу использовать REPL с функцией CPS?

Я только что столкнулся с withSession :: (Session -> IO a) -> IO a пакета wreq. Я хочу оценить продолжение строки за строкой, но я не могу найти для этого никакого способа.

import Network.Wreq.Session as S
withSession $ \sess -> do
  res <- S.getWith opts sess "http://stackoverflow.com/questions"
  -- print res
  -- .. other things

В вышеприведенном фрагменте, как я могу оценить print res в ghci? Другими словами, могу ли я получить тип Session в ghci?

Ответы

Ответ 1

Замечательный вопрос.

Я не знаю методов, которые могут повторно вводить GHCi REPL, чтобы мы могли использовать это в функциях CPS. Возможно, другие могут предложить какой-то способ.

Однако я могу предложить взломать. В принципе, можно использовать concurrency, чтобы вывести CPS изнутри, если он основан на монаде IO, как в этом случае.

Здесь взлом: используйте это в сеансе GHCi

> sess <- newEmptyMVar :: IO (MVar Session)
> stop <- newEmptyMVar :: IO (MVar ())
> forkIO $ withSession $ \s -> putMVar sess s >> takeMVar stop
> s <- takeMVar sess
> -- use s here as if you were inside withSession
> let s = () -- recommended
> putMVar stop ()
> -- we are now "outside" withSession, don't try to access s here!

Небольшая библиотека для автоматизации взлома:

data CPSControl b = CPSControl (MVar ()) (MVar b)

startDebugCps :: ((a -> IO ()) -> IO b) -> IO (a, CPSControl b)
startDebugCps cps = do
   cpsVal <- newEmptyMVar
   retVal <- newEmptyMVar
   stop   <- newEmptyMVar
   _ <- forkIO $ do
      x <- cps $ \c -> putMVar cpsVal c >> takeMVar stop
      putMVar retVal x
   s <- takeMVar cpsVal
   return (s, CPSControl stop retVal)

stopDebugCps :: CPSControl b -> IO b
stopDebugCps (CPSControl stop retVal) = do
   putMVar stop ()
   takeMVar retVal

testCps :: (String -> IO ()) -> IO String
testCps act = do
   putStrLn "testCps: begin"
   act "here some string!"
   putStrLn "testCps: end"
   return "some return value"

Быстрый тест:

> (x, ctrl) <- startDebugCps testCps
testCps: begin
> x
"here some string!"
> stopDebugCps ctrl
testCps: end
"some return value"