RefactoringTools / HaRe

The Haskell Refactoring Tool
http://www.cs.kent.ac.uk/projects/refactor-fp/
Other
139 stars 32 forks source link

Rename messes up exports list #63

Open nh2 opened 6 years ago

nh2 commented 6 years ago

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.