Skip to content
This repository has been archived by the owner on Jan 2, 2021. It is now read-only.

Commit

Permalink
Remove DelayedActionExtra
Browse files Browse the repository at this point in the history
  • Loading branch information
wz1000 committed Jun 23, 2020
1 parent 06c66d3 commit 3a064ee
Show file tree
Hide file tree
Showing 3 changed files with 8 additions and 26 deletions.
2 changes: 2 additions & 0 deletions bench/lib/Experiments.hs
Original file line number Diff line number Diff line change
Expand Up @@ -280,6 +280,8 @@ runBenchmarks allBenchmarks = do
unwords $
[ ghcide ?config,
"--lsp",
"--test",
"--verbose",
"--cwd",
dir,
"+RTS",
Expand Down
2 changes: 0 additions & 2 deletions src/Development/IDE/Core/Rules.hs
Original file line number Diff line number Diff line change
Expand Up @@ -84,8 +84,6 @@ import System.Directory ( getModificationTime )
import Control.Exception

import Control.Monad.State
import System.IO.Error (isDoesNotExistError)
import Control.Exception.Safe (IOException, catch)
import FastString (FastString(uniq))
import qualified HeaderInfo as Hdr

Expand Down
30 changes: 6 additions & 24 deletions src/Development/IDE/Core/Shake.hs
Original file line number Diff line number Diff line change
Expand Up @@ -498,35 +498,18 @@ withMVar' var unmasked masked = mask $ \restore -> do
pure c


-- | Actions with an ID for tracing purposes
data DelayedActionExtra
= DelayedActionExtra
{ _actionInternalId :: Unique
, _actionInternal :: Action ()
}

type DelayedAction a = DelayedActionX (Action a)
type DelayedActionInternal = DelayedActionX DelayedActionExtra

{-# COMPLETE DelayedActionInternal#-}
pattern DelayedActionInternal :: String -> Logger.Priority -> Action () -> Unique -> DelayedActionX DelayedActionExtra
pattern DelayedActionInternal { _actionInternalName, _actionInternalPriority, getAction , _actionId}
= DelayedActionX _actionInternalName _actionInternalPriority (DelayedActionExtra _actionId getAction)

{-# COMPLETE DelayedAction#-}
pattern DelayedAction :: String -> Logger.Priority -> Action a -> DelayedAction a
pattern DelayedAction a b c = DelayedActionX a b c

mkDelayedAction :: String -> Logger.Priority -> Action a -> DelayedAction a
mkDelayedAction = DelayedAction

data DelayedActionX a = DelayedActionX
data DelayedAction a = DelayedAction
{ actionName :: String -- ^ Name we show to the user
, actionPriority :: Logger.Priority -- ^ Priority with which to log the action
, _actionExtra :: a -- ^ The payload
, getAction :: Action a -- ^ The payload
}

instance Show (DelayedActionX a) where
type DelayedActionInternal = DelayedAction ()

instance Show (DelayedAction a) where
show d = "DelayedAction: " ++ actionName d

-- | These actions are run asynchronously after the current action is
Expand Down Expand Up @@ -640,7 +623,6 @@ newSession ShakeExtras{..} shakeDb systemActs userActs = do
instantiateDelayedAction :: DelayedAction a -> IO (Barrier (Either SomeException a), DelayedActionInternal)
instantiateDelayedAction (DelayedAction s p a) = do
b <- newBarrier
i <- newUnique
let a' = do
-- work gets reenqueued when the Shake session is restarted
-- it can happen that a work item finished just as it was reenqueud
Expand All @@ -649,7 +631,7 @@ instantiateDelayedAction (DelayedAction s p a) = do
unless alreadyDone $ do
x <- actionCatch @SomeException (Right <$> a) (pure . Left)
liftIO $ signalBarrier b x
let d = DelayedActionInternal s p a' i
let d = DelayedAction s p a'
return (b, d)

logDelayedAction :: Logger -> DelayedActionInternal -> Action ()
Expand Down

0 comments on commit 3a064ee

Please sign in to comment.