Skip to content

Rename messes up exports list #63

@nh2

Description

@nh2

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

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions