LINUX.ORG.RU

не могу собрать код из real world haskell

 


0

1

Вот этот код не собирается потому что был написан под Control.OldException который давно выкинули. Моих знаний не хватило чтобы переделать. Можете подсказать что поменять?

module NiceFork
    (
      ThreadManager
    , newManager
    , forkManaged
    , getStatus
    , waitFor
    , waitAll
    ) where

import Control.Monad (join)
import Control.Concurrent
import Control.Exception (Exception, try)

import qualified Data.Map as M

data ThreadStatus = Running
                  | Finished         -- terminated normally
                  | Threw Exception  -- killed by uncaught exception
                    deriving (Eq, Show)

newtype ThreadManager =
    Mgr (MVar (M.Map ThreadId (MVar ThreadStatus)))
    deriving (Eq)

-- | Sleep :)
sleep :: Double -> IO ()
sleep s = threadDelay $ round $ s * 1000000

-- | Create a new thread manager.
newManager :: IO ThreadManager
newManager = Mgr `fmap` newMVar M.empty

-- | Create a new managed thread.
forkManaged :: ThreadManager -> IO () -> IO ThreadId
forkManaged (Mgr mgr) body =
    modifyMVar mgr $ \m -> do
      state <- newEmptyMVar
      tid <- forkIO $ do
        result <- try body
        putMVar state (either Threw (const Finished) result)
      return (M.insert tid state m, tid)

-- | Immediately return the status of a managed thread.
getStatus :: ThreadManager -> ThreadId -> IO (Maybe ThreadStatus)
getStatus (Mgr mgr) tid =
  modifyMVar mgr $ \m ->
    case M.lookup tid m of
      Nothing -> return (m, Nothing)
      Just st -> tryTakeMVar st >>= \mst -> case mst of
                   Nothing -> return (m, Just Running)
                   Just sth -> return (M.delete tid m, Just sth)

-- | Block until a specific managed thread terminates.
waitFor :: ThreadManager -> ThreadId -> IO (Maybe ThreadStatus)
waitFor (Mgr mgr) tid =
  join . modifyMVar mgr $ \m ->
    return $ case M.updateLookupWithKey (\_ _ -> Nothing) tid m of
      (Nothing, _) -> (m, return Nothing)
      (Just st, m') -> (m', Just `fmap` takeMVar st)


-- | Block until all managed threads terminate.
waitAll :: ThreadManager -> IO ()
waitAll (Mgr mgr) = modifyMVar mgr elems >>= mapM_ takeMVar
    where elems m = return (M.empty, M.elems m)

В комментах к электронной версии книги наверняка должно быть решение.

А вообще, основная шутка с real world haskell'ем в том, что real world уже несколько раз сменился, а сама книга утратила актуальность по большому счёту ещё до того момента, как первый комок этой каши покинул пределы книжного издательства.

dmitry_malikov ★★ ()

1). включение ошибки в лог сильно упрощает задачу отвечающим

2).

diff --git a/1.hs b/1.hs
index 5bd5172..5b4f6c3 100644
--- a/1.hs
+++ b/1.hs
@@ -10,14 +10,14 @@ module NiceFork
 
 import Control.Monad (join)
 import Control.Concurrent
-import Control.Exception (Exception, try)
+import Control.Exception.Extensible (Exception, IOException, try)
 
 import qualified Data.Map as M
 
 data ThreadStatus = Running
-                  | Finished         -- terminated normally
-                  | Threw Exception  -- killed by uncaught exception
-                    deriving (Eq, Show)
+                  | Finished            -- terminated normally
+                  | Threw IOException   -- killed by uncaught exception
+                  deriving (Eq, Show)
 
 newtype ThreadManager =
     Mgr (MVar (M.Map ThreadId (MVar ThreadStatus)))

это тоже самое, но это не правильно, т.к. не ловит UserExceptions и прочие.

qnikst ★★★★★ ()

Для GHC - заменить тип Exception на SomeException и убрать Eq из deriving (если нужно - написать отдельно как instance Eq ThreadStatus where ...), так try будет помещать в Threw _ :: ThreadStatus любое исключение, и IO, и чистое. Для Haskell98 - IOError вместо Exception и оставить Eq, но это только для IO исключений.

quasimoto ★★★★ ()

Можно сузить класс перехватываемых ошибок и заменить в тексте слово Exception на более узкое по смыслу IOException.

dave ★★★★★ ()

Спасибо за помощь, скоро буду дома и попробую.

anonymous ()
diff --git a/1.hs b/1.hs
index 5bd5172..12c9120 100644
--- a/1.hs
+++ b/1.hs
@@ -10,17 +10,17 @@ module NiceFork
 
 import Control.Monad (join)
 import Control.Concurrent
-import Control.Exception (Exception, try)
+import Control.Exception (Exception, IOException, try)
 
 import qualified Data.Map as M
 
-data ThreadStatus = Running
-                  | Finished         -- terminated normally
-                  | Threw Exception  -- killed by uncaught exception
+data ThreadStatus e = Running
+                    | Finished            -- terminated normally
+                    | Threw e             -- killed by uncaught exception
                     deriving (Eq, Show)
 
-newtype ThreadManager =
-    Mgr (MVar (M.Map ThreadId (MVar ThreadStatus)))
+newtype ThreadManager e =
+    Mgr (MVar (M.Map ThreadId (MVar (ThreadStatus e))))
     deriving (Eq)
 
 -- | Sleep :)
@@ -28,11 +28,11 @@ sleep :: Double -> IO ()
 sleep s = threadDelay $ round $ s * 1000000
 
 -- | Create a new thread manager.
-newManager :: IO ThreadManager
+newManager :: IO (ThreadManager e)
 newManager = Mgr `fmap` newMVar M.empty
 
 -- | Create a new managed thread.
-forkManaged :: ThreadManager -> IO () -> IO ThreadId
+forkManaged :: (Exception e) => (ThreadManager e) -> IO () -> IO ThreadId
 forkManaged (Mgr mgr) body =
     modifyMVar mgr $ \m -> do
       state <- newEmptyMVar
@@ -42,7 +42,7 @@ forkManaged (Mgr mgr) body =
       return (M.insert tid state m, tid)
 
 -- | Immediately return the status of a managed thread.
-getStatus :: ThreadManager -> ThreadId -> IO (Maybe ThreadStatus)
+getStatus :: (ThreadManager e) -> ThreadId -> IO (Maybe (ThreadStatus e))
 getStatus (Mgr mgr) tid =
   modifyMVar mgr $ \m ->
     case M.lookup tid m of
@@ -52,7 +52,7 @@ getStatus (Mgr mgr) tid =
                    Just sth -> return (M.delete tid m, Just sth)
 
 -- | Block until a specific managed thread terminates.
-waitFor :: ThreadManager -> ThreadId -> IO (Maybe ThreadStatus)
+waitFor :: (ThreadManager e) -> ThreadId -> IO (Maybe (ThreadStatus e))
 waitFor (Mgr mgr) tid =
   join . modifyMVar mgr $ \m ->
     return $ case M.updateLookupWithKey (\_ _ -> Nothing) tid m of
@@ -61,6 +61,6 @@ waitFor (Mgr mgr) tid =
 
 
 -- | Block until all managed threads terminate.
-waitAll :: ThreadManager -> IO ()
+waitAll :: (ThreadManager e) -> IO ()
 waitAll (Mgr mgr) = modifyMVar mgr elems >>= mapM_ takeMVar
     where elems m = return (M.empty, M.elems m)

а вот так совсем правильно, поскольку использует новые исключения и можно указать, что ловить.

qnikst ★★★★★ ()
Ответ на: комментарий от qnikst

использование

import NiceFork
import Control.Concurrent
import Control.Monad
import Control.Exception

main = do
  mgr <- newManager ::IO (ThreadManager SomeException)
  forM_ [1..10] $ \i -> forkManaged mgr $ threadDelay (i*1000000)
  waitAll mgr

вместо SomeException можно подствить IOException или какое-то UserException.

qnikst ★★★★★ ()
Ответ на: комментарий от qnikst

Так завершившийся с непредусмотренным e исключением код не отметится ни как Finished, ни как Threw, а останется Running, так что лучше всё-таки SomeException, чтобы не создавать лишних проблем и не усложнять интерфейс.

quasimoto ★★★★ ()
Ответ на: комментарий от true_admin

В новых exception можно указывать какой тип исключений нужно ловить (всё остальное пропускается к обработчику выше уровнем, находящемуся в том же треде), так же таким образом можно делать разные реакции на разные исключения, см. 'catches'. По этому часто хорошим тоном является ловля не SomeException, а подкласса исключений, чтобы или отдельно обрабатывать часть, плюс сразу же ловить ^C, последнее относится к top-level коду. Поскольку здесь код не top-level и его корректность зависит от обработки исключений, то тут нужно использовать в тредах SomeException, как писал quasimoto.

И наверное по делу, это не передача исключения, это параметризация типа, поскольку после моих изменений код стал полиморфным по типу e, то при его использовании компилятор или должен уметь его вывести, или нужно его явно указать, что я и сделал.

qnikst ★★★★★ ()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.