Haskell: как отключить функцию, выполняющую внешнюю команду

Я вызываю внешнюю программу внутри функции. Теперь я хотел бы отключить эту функцию, а не только внешнюю программу. Но после того, как функция истечет, внешняя программа все еще работает на моем компьютере (я использую debian) до тех пор, пока она не закончит вычисление, после чего ее поток по-прежнему остается в таблице процессов как подпрограмма моей основной программы до тех пор, пока основная программа завершается.

Вот два минимальных примера, которые иллюстрируют то, что я хотел бы сделать. Первый использует unsafePerformIO, второй - полностью в монаде IO. Я действительно не зависим от небезопасногоPerformIO, но хотел бы сохранить его, если это возможно. Описанная проблема происходит с ней и без нее.

С небезопаснымPerformIO

module Main where

import System.Timeout
import Criterion.Measurement
import System.IO.Unsafe
import System.Process

main = do
    x <- time $ timeoutP (1 * 1000000) $ mytest 2
    y <- getLine
    putStrLn $ show x ++ y

timeoutP :: Int -> a -> IO (Maybe a)
timeoutP t fun = timeout t $ return $! fun

mytest :: Int -> String
mytest n =
  let
    x = runOnExternalProgram $ n * 1000
  in
    x ++ ". Indeed."

runOnExternalProgram :: Int -> String
runOnExternalProgram n = unsafePerformIO $ do
    -- convert the input to a parameter of the external program
    let x = show $ n + 12
    -- run the external program
    -- (here i use "sleep" to indicate a slow computation)
    answer <- readProcess "sleep" [x] ""
    -- convert the output as needed
    let verboseAnswer = "External program answered: " ++ answer
    return verboseAnswer

Без unsafePerformIO

module Main where

import System.Timeout
import Criterion.Measurement
import System.IO.Unsafe
import System.Process

main = do
    x <- time $ timeout (1 * 1000000) $ mytest 2
    y <- getLine
    putStrLn $ show x ++ y

mytest :: Int -> IO String
mytest n = do
    x <- runOnExternalProgram $ n * 1000
    return $ x ++ ". Indeed."

runOnExternalProgram :: Int -> IO String
runOnExternalProgram n = do
    -- convert the input to a parameter for the external program:
    let x = show $ n + 12
    -- run the external program
    -- (here i use "sleep" to indicate a slow computation):
    answer <- readProcess "sleep" [x] ""
    -- convert the output as needed:
    let verboseAnswer = "External program answered: " ++ answer
    return verboseAnswer

Возможно, скобка может помочь, но я действительно не знаю, как это сделать.

Изменить: я принял ответ Джона Л. Теперь я использую следующее:

import Control.Concurrent
import Control.Exception
import System.Exit
import System.IO
import System.IO.Error
import System.Posix.Signals
import System.Process
import System.Process.Internals

safeCreateProcess :: String -> [String] -> StdStream -> StdStream -> StdStream
                  -> ( ( Maybe Handle
                       , Maybe Handle
                       , Maybe Handle
                       , ProcessHandle
                       ) -> IO a )
                  -> IO a
safeCreateProcess prog args streamIn streamOut streamErr fun = bracket
    ( do
        h <- createProcess (proc prog args) 
                 { std_in  = streamIn
                 , std_out = streamOut
                 , std_err = streamErr
                 , create_group = True }
        return h
    )
-- "interruptProcessGroupOf" is in the new System.Process. Since some
-- programs return funny exit codes i implemented a "terminateProcessGroupOf".
--    (\(_, _, _, ph) -> interruptProcessGroupOf ph >> waitForProcess ph)
    (\(_, _, _, ph) -> terminateProcessGroup ph >> waitForProcess ph)
    fun
{-# NOINLINE safeCreateProcess #-}

safeReadProcess :: String -> [String] -> String -> IO String
safeReadProcess prog args str =
    safeCreateProcess prog args CreatePipe CreatePipe Inherit
      (\(Just inh, Just outh, _, ph) -> do
        hPutStr inh str
        hClose inh
        -- fork a thread to consume output
        output <- hGetContents outh
        outMVar <- newEmptyMVar
        forkIO $ evaluate (length output) >> putMVar outMVar ()
        -- wait on output
        takeMVar outMVar
        hClose outh
        return output
-- The following would be great, if some programs did not return funny
-- exit codes!
--            ex <- waitForProcess ph
--            case ex of
--                ExitSuccess -> return output
--                ExitFailure r ->
--                    fail ("spawned process " ++ prog ++ " exit: " ++ show r)
      )

terminateProcessGroup :: ProcessHandle -> IO ()
terminateProcessGroup ph = do
    let (ProcessHandle pmvar) = ph
    ph_ <- readMVar pmvar
    case ph_ of
        OpenHandle pid -> do  -- pid is a POSIX pid
            signalProcessGroup 15 pid
        otherwise -> return ()

Это решает мою проблему. Он убивает все дочерние процессы порожденного процесса и что в нужное время.

С уважением.