@@ -1,23 +1,33 @@
11module Servant.Server.Internal.RoutingApplicationSpec (spec) where
22
3+import Prelude ()
4+import Prelude.Compat
5+
36import Control.Exception hiding (Handler)
47import Control.Monad.IO.Class
8+import Data.Maybe (isJust)
9+import Data.IORef
510import Servant.Server
611import Servant.Server.Internal.RoutingApplication
7−import System.Directory
812import Test.Hspec
913
14+import System.IO.Unsafe (unsafePerformIO)
15+
1016ok :: IO (RouteResult ())
1117ok = return (Route ())
1218
19+-- Let's not write to the filesystem
20+delayedTestRef :: IORef (Maybe String)
21+delayedTestRef = unsafePerformIO $ newIORef Nothing
22+
1323delayed :: DelayedIO () -> RouteResult (Handler ()) -> Delayed () (Handler ())
1424delayed body srv = Delayed
1525 { capturesD = \() -> DelayedIO $ \_req _cl -> ok
1626 , methodD = DelayedIO $ \_req_ _cl -> ok
1727 , authD = DelayedIO $ \_req _cl -> ok
1828 , bodyD = do
19− liftIO (writeFile "delayed.test" "hia")
20− addCleanup (removeFile "delayed.test" >> putStrLn "file removed")
29+ liftIO (writeIORef delayedTestRef (Just "hia") >> putStrLn "garbage created")
30+ addCleanup (writeIORef delayedTestRef Nothing >> putStrLn "garbage collected")
2131 body
2232 , serverD = \() () _body _req -> srv
2333 }
@@ -35,17 +45,17 @@ spec = do
3545 describe "Delayed" $ do
3646 it "actually runs clean up actions" $ do
3747 _ <- simpleRun $ delayed (return ()) (Route $ return ())
38− fileStillThere <- doesFileExist "delayed.test"
39− fileStillThere `shouldBe` False
48+ cleanUpDone <- isJust <$> readIORef delayedTestRef
49+ cleanUpDone `shouldBe` False
4050 it "even with exceptions in serverD" $ do
4151 _ <- simpleRun $ delayed (return ()) (Route $ throw DivideByZero)
42− fileStillThere <- doesFileExist "delayed.test"
43− fileStillThere `shouldBe` False
52+ cleanUpDone <- isJust <$> readIORef delayedTestRef
53+ cleanUpDone `shouldBe` False
4454 it "even with routing failure in bodyD" $ do
4555 _ <- simpleRun $ delayed (delayedFailFatal err500) (Route $ return ())
46− fileStillThere <- doesFileExist "delayed.test"
47− fileStillThere `shouldBe` False
56+ cleanUpDone <- isJust <$> readIORef delayedTestRef
57+ cleanUpDone `shouldBe` False
4858 it "even with exceptions in bodyD" $ do
4959 _ <- simpleRun $ delayed (liftIO $ throwIO DivideByZero) (Route $ return ())
50− fileStillThere <- doesFileExist "delayed.test"
51− fileStillThere `shouldBe` False
60+ cleanUpDone <- isJust <$> readIORef delayedTestRef
61+ cleanUpDone `shouldBe` False