-
Notifications
You must be signed in to change notification settings - Fork 32
Open
Description
I'm using haskell-ide-engine (commit cc71e5bd
, and the version of HaRe that this depends on) with Sublime Text HST and when renaming the function name at this line with it to pooledMapConcurrently2
, it modifies the file like so:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module PooledMapConcurrently
pooledMapConcurrently2 :: (Traversable t, MonadIO m, Async.Forall (Async.Pure m), MonadBaseControl IO m) => (a -> m b) -> t a -> m (t b)
pooledMapConcurrently2 f xs = do
, pooledMapConcurrently'
) where
import Control.Concurrent.Async.Lifted (Concurrently(..))
import qualified Control.Concurrent.Async.Lifted.Safe as Async
import Control.Concurrent.MVar.Lifted
import Control.Monad.Trans
import Control.Monad.Trans.Control
import Data.IORef
import Data.Foldable
import Data.Traversable
import GHC.Conc (getNumCapabilities)
( pooledMapConcurrently2
numProcs <- liftIO getNumCapabilities
pooledMapConcurrently' numProcs f xs
pooledMapConcurrently' :: forall t m a b . (Traversable t, MonadIO m, Async.Forall (Async.Pure m), MonadBaseControl IO m) => Int -> (a -> m b) -> t a -> m (t b)
pooledMapConcurrently' numThreads f xs = if numThreads < 1
then error ("pooledMapConcurrently: numThreads < 1 (" ++ show numThreads ++ ")")
else do
jobs :: t (a, IORef b) <- liftIO $ for xs (\x -> (x, ) <$> newIORef (error "pooledMapConcurrently: empty IORef"))
jobsVar :: MVar [(a, IORef b)] <- liftIO $ newMVar (toList jobs)
runConcurrently $ for_ [1..numThreads] $ \_ -> Concurrently $ do
let loop :: m ()
loop = do
m'job :: Maybe (a, IORef b) <- liftIO $ modifyMVar jobsVar $ \case
[] -> return ([], Nothing)
var : vars -> return (vars, Just var)
for_ m'job $ \(x, outRef) -> do
y <- f x
liftIO $ atomicWriteIORef outRef y
loop
loop
liftIO $ for jobs (\(_, outputRef) -> readIORef outputRef)
Note the broken exports list and the function losing its type signature and first line.
Metadata
Metadata
Assignees
Labels
No labels