@@ -77,8 +77,8 @@ module Development.IDE.Core.Shake(
7777    ) where 
7878
7979import            Control.Concurrent.Async 
80- import            Control.Concurrent.Extra 
8180import            Control.Concurrent.STM 
81+ import            Control.Concurrent.Strict 
8282import            Control.DeepSeq 
8383import            Control.Monad.Extra 
8484import            Control.Monad.IO.Class 
@@ -247,9 +247,7 @@ getPluginConfig extras plugin = do
247247addPersistentRule  ::  IdeRule  k  v  =>  k  ->  (NormalizedFilePath  ->  IdeAction  (Maybe v ,PositionDelta ,TextDocumentVersion ))) ->  Rules  () 
248248addPersistentRule k getVal =  do 
249249  ShakeExtras {persistentKeys} <-  getShakeExtrasRules
250-   liftIO $  modifyVar_ persistentKeys $  \ hm ->  do 
251-     pure  $  HMap. insert (Key  k) (fmap  (fmap  (first3 toDyn)) .  getVal) hm
252-   return  () 
250+   void $  liftIO $  modifyVar' persistentKeys $  HMap. insert (Key  k) (fmap  (fmap  (first3 toDyn)) .  getVal)
253251
254252class  Typeable  a  =>  IsIdeGlobal  a  where 
255253
@@ -273,7 +271,7 @@ addIdeGlobal x = do
273271
274272addIdeGlobalExtras  ::  IsIdeGlobal  a  =>  ShakeExtras  ->  a  ->  IO () 
275273addIdeGlobalExtras ShakeExtras {globals} x@ (typeOf ->  ty) = 
276-     liftIO $  modifyVar_  globals $  \ mp ->  case  HMap. lookup  ty mp of 
274+     void  $   liftIO $  modifyVarIO'  globals $  \ mp ->  case  HMap. lookup  ty mp of 
277275        Just  _ ->  errorIO $  " Internal error, addIdeGlobalExtras, got the same type twice for " ++  show  ty
278276        Nothing  ->  return  $!  HMap. insert ty (toDyn x) mp
279277
@@ -325,10 +323,13 @@ lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do
325323            f <-  MaybeT  $  pure  $  HMap. lookup  (Key  k) pmap
326324            (dv,del,ver) <-  MaybeT  $  runIdeAction " lastValueIO" $  f file
327325            MaybeT  $  pure  $  (,del,ver) <$>  fromDynamic dv
328-           modifyVar state $  \ hm ->  pure  $  case  mv of 
329-             Nothing  ->  (HMap. alter (alterValue $  Failed  True Key  k) hm,Nothing )
330-             Just  (v,del,ver) ->  (HMap. alter (alterValue $  Stale  (Just  del) ver (toDyn v)) (file,Key  k) hm
331-                                 ,Just  (v,addDelta del $  mappingForVersion allMappings file ver))
326+           case  mv of 
327+             Nothing  ->  do 
328+                 void $  modifyVar' state $  HMap. alter (alterValue $  Failed  True Key  k)
329+                 return  Nothing 
330+             Just  (v,del,ver) ->  do 
331+                 void $  modifyVar' state $  HMap. alter (alterValue $  Stale  (Just  del) ver (toDyn v)) (file,Key  k)
332+                 return  $  Just  (v,addDelta del $  mappingForVersion allMappings file ver)
332333
333334        --  We got a new stale value from the persistent rule, insert it in the map without affecting diagnostics
334335        alterValue new Nothing  =  Just  (ValueWithDiagnostics  new mempty ) --  If it wasn't in the map, give it empty diagnostics
@@ -416,9 +417,9 @@ setValues :: IdeRule k v
416417          ->  Value  v 
417418          ->  Vector  FileDiagnostic 
418419          ->  IO () 
419- setValues state key file val diags =  modifyVar_ state  $   \ vals  ->   do 
420-     --  Force to make sure the old HashMap is not retained 
421-     evaluate  $   HMap. insert (file,  Key  key) ( ValueWithDiagnostics  ( fmap  toDyn val) diags) vals 
420+ setValues state key file val diags = 
421+     void  $  modifyVar' state  $   HMap. insert (file,  Key  key) ( ValueWithDiagnostics  ( fmap  toDyn val) diags) 
422+ 
422423
423424--  |  Delete the value stored for a given ide build key 
424425deleteValue
@@ -427,8 +428,7 @@ deleteValue
427428  ->  k 
428429  ->  NormalizedFilePath 
429430  ->  IO () 
430- deleteValue ShakeExtras {state} key file =  modifyVar_ state $  \ vals -> 
431-     evaluate $  HMap. delete (file, Key  key) vals
431+ deleteValue ShakeExtras {state} key file =  void $  modifyVar' state $  HMap. delete (file, Key  key)
432432
433433--  |  We return Nothing if the rule has not run and Just Failed if it has failed to produce a value. 
434434getValues  :: 
@@ -783,17 +783,15 @@ garbageCollect :: (NormalizedFilePath -> Bool) -> Action ()
783783garbageCollect keep =  do 
784784    ShakeExtras {state, diagnostics,hiddenDiagnostics,publishedDiagnostics,positionMapping} <-  getShakeExtras
785785    liftIO $ 
786-         do  newState <-  modifyVar state $  \ values ->  do 
787-                values <-  evaluate $  HMap. filterWithKey (\ (file, _) _ ->  keep file) values
788-                return  $!  dupe values
789-            modifyVar_ diagnostics $  \ diags ->  return  $!  filterDiagnostics keep diags
790-            modifyVar_ hiddenDiagnostics $  \ hdiags ->  return  $!  filterDiagnostics keep hdiags
791-            modifyVar_ publishedDiagnostics $  \ diags ->  return  $!  HMap. filterWithKey (\ uri _ ->  keep (fromUri uri)) diags
786+         do  newState <-  modifyVar' state $  HMap. filterWithKey (\ (file, _) _ ->  keep file)
787+            void $  modifyVar' diagnostics $  filterDiagnostics keep
788+            void $  modifyVar' hiddenDiagnostics $  filterDiagnostics keep
789+            void $  modifyVar' publishedDiagnostics $  HMap. filterWithKey (\ uri _ ->  keep (fromUri uri))
792790           let  versionsForFile = 
793791                   HMap. fromListWith Set. union $ 
794792                   mapMaybe (\ ((file, _key), ValueWithDiagnostics  v _) ->  (filePathToUri' file,) .  Set. singleton <$>  valueVersion v) $ 
795793                   HMap. toList newState
796-            modifyVar_ positionMapping  $   \ mappings  ->   return   $!  filterVersionMap versionsForFile mappings 
794+            void  $  modifyVar' positionMapping  $  filterVersionMap versionsForFile
797795
798796--  |  Define a new Rule without early cutoff 
799797define
@@ -994,7 +992,7 @@ defineEarlyCutoff' doDiagnostics key file old mode action = do
994992            --  This functions are deliberately eta-expanded to avoid space leaks.
995993            --  Do not remove the eta-expansion without profiling a session with at
996994            --  least 1000 modifications.
997-             where  f shift =  modifyVar_ var  $   \ x  ->  evaluate  $  HMap. insertWith (\ _ x ->  shift x) file (shift 0 ) x 
995+             where  f shift =  void  $  modifyVar' var  $  HMap. insertWith (\ _ x ->  shift x) file (shift 0 )
998996
999997isSuccess  ::  RunResult  (A  v ) ->  Bool 
1000998isSuccess (RunResult  _ _ (A  Failed {})) =  False 
@@ -1086,17 +1084,17 @@ updateFileDiagnostics fp k ShakeExtras{logger, diagnostics, hiddenDiagnostics, p
10861084    let  (currentShown, currentHidden) =  partition ((==  ShowDiag ) .  fst ) current
10871085        uri =  filePathToUri' fp
10881086        ver =  vfsVersion =<<  modTime
1089-         updateDiagnosticsWithForcing  new store =   do 
1090-             store' <-  evaluate  $  setStageDiagnostics uri ver (T. pack $  show  k) new store
1091-             new'  <-  evaluate  $  getUriDiagnostics uri store'
1092-             return  (store', new')
1087+         update  new store = 
1088+             let   store' =  setStageDiagnostics uri ver (T. pack $  show  k) new store
1089+                 new'  =  getUriDiagnostics uri store'
1090+             in  (store', new')
10931091    mask_ $  do 
10941092        --  Mask async exceptions to ensure that updated diagnostics are always
10951093        --  published. Otherwise, we might never publish certain diagnostics if
10961094        --  an exception strikes between modifyVar but before
10971095        --  publishDiagnosticsNotification.
1098-         newDiags <-  modifyVar diagnostics $  updateDiagnosticsWithForcing  $   map  snd  currentShown
1099-         _ <-  modifyVar hiddenDiagnostics $   updateDiagnosticsWithForcing  $   map  snd  currentHidden
1096+         newDiags <-  modifyVar diagnostics $  pure   .  update ( map  snd  currentShown) 
1097+         _ <-  modifyVar hiddenDiagnostics $   pure   .  update ( map  snd  currentHidden) 
11001098        let  uri =  filePathToUri' fp
11011099        let  delay =  if  null  newDiags then  0.1  else  0 
11021100        registerEvent debouncer delay uri $  do 
@@ -1182,6 +1180,6 @@ updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} Versi
11821180                Map. mapAccumRWithKey (\ acc _k (delta, _) ->  let  new =  addDelta delta acc in  (new, (delta, acc)))
11831181                  zeroMapping
11841182                  (Map. insert _version (shared_change, zeroMapping) mappingForUri)
1185-         pure  $!   HMap. insert uri updatedMapping allMappings
1183+         pure  $  HMap. insert uri updatedMapping allMappings
11861184  where 
11871185    shared_change =  mkDelta changes
0 commit comments