|
4 | 4 | {-# LANGUAGE ScopedTypeVariables #-}
|
5 | 5 | {-# LANGUAGE TypeOperators #-}
|
6 | 6 | {-# LANGUAGE ViewPatterns #-}
|
| 7 | +{-# LANGUAGE TypeApplications #-} |
7 | 8 |
|
8 | 9 | module Utils where
|
9 | 10 |
|
@@ -116,20 +117,27 @@ mkGoldenTest eq tc occ line col input =
|
116 | 117 | -- wait for the entire build to finish, so that Tactics code actions that
|
117 | 118 | -- use stale data will get uptodate stuff
|
118 | 119 | void waitForBuildQueue
|
119 |
| - actions <- getCodeActions doc $ pointRange line col |
120 |
| - case find ((== Just (tacticTitle tc occ)) . codeActionTitle) actions of |
121 |
| - Just (InR CodeAction {_command = Just c}) -> do |
122 |
| - executeCommand c |
123 |
| - _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) |
124 |
| - edited <- documentContents doc |
125 |
| - let expected_name = input <.> "expected" <.> "hs" |
126 |
| - -- Write golden tests if they don't already exist |
127 |
| - liftIO $ (doesFileExist expected_name >>=) $ flip unless $ do |
128 |
| - T.writeFile expected_name edited |
129 |
| - expected <- liftIO $ T.readFile expected_name |
130 |
| - liftIO $ edited `eq` expected |
131 |
| - _ -> error $ show actions |
132 |
| - |
| 120 | + retryAction 4 $ do |
| 121 | + actions <- getCodeActions doc $ pointRange line col |
| 122 | + case find ((== Just (tacticTitle tc occ)) . codeActionTitle) actions of |
| 123 | + Just (InR CodeAction {_command = Just c}) -> do |
| 124 | + executeCommand c |
| 125 | + _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) |
| 126 | + edited <- documentContents doc |
| 127 | + let expected_name = input <.> "expected" <.> "hs" |
| 128 | + -- Write golden tests if they don't already exist |
| 129 | + liftIO $ (doesFileExist expected_name >>=) $ flip unless $ do |
| 130 | + T.writeFile expected_name edited |
| 131 | + expected <- liftIO $ T.readFile expected_name |
| 132 | + liftIO $ E.try (edited `eq` expected) |
| 133 | + _ -> return $ Left $ E.toException $ E.ErrorCall $ show actions |
| 134 | + |
| 135 | +retryAction :: Int -> Session (Either E.SomeException a) -> Session a |
| 136 | +retryAction n act = do |
| 137 | + res <- act |
| 138 | + case (n, res) of |
| 139 | + (_, Right x) -> return x |
| 140 | + (_, Left e) -> if n>1 then retryAction (n-1) act else E.throw e |
133 | 141 |
|
134 | 142 | mkCodeLensTest
|
135 | 143 | :: FilePath
|
|
0 commit comments