Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Rename messes up exports list #63

Open
nh2 opened this issue Oct 16, 2017 · 0 comments
Open

Rename messes up exports list #63

nh2 opened this issue Oct 16, 2017 · 0 comments

Comments

@nh2
Copy link

nh2 commented Oct 16, 2017

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.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant