module Servant.Server.Internal.RoutingApplicationSpec (spec) where

import Prelude ()
import Prelude.Compat

import Control.Exception hiding (Handler)
import Control.Monad.IO.Class
import Data.Maybe (isJust)
import Data.IORef
import Servant.Server
import Servant.Server.Internal.RoutingApplication
import Test.Hspec

import System.IO.Unsafe (unsafePerformIO)

ok :: IO (RouteResult ())
ok = return (Route ())

-- Let's not write to the filesystem
delayedTestRef :: IORef (Maybe String)
delayedTestRef = unsafePerformIO $ newIORef Nothing

delayed :: DelayedIO () -> RouteResult (Handler ()) -> Delayed () (Handler ())
delayed body srv = Delayed
  { capturesD = \() -> DelayedIO $ \_req _cl -> ok
  , methodD = DelayedIO $ \_req_ _cl -> ok
  , authD = DelayedIO $ \_req _cl -> ok
  , bodyD = do
      liftIO (writeIORef delayedTestRef (Just "hia") >> putStrLn "garbage created")
      addCleanup (writeIORef delayedTestRef Nothing >> putStrLn "garbage collected")
      body
  , serverD = \() () _body _req -> srv
  }

simpleRun :: Delayed () (Handler ())
          -> IO ()
simpleRun d = fmap (either ignoreE id) . try $
  runAction d () undefined (\_ -> return ()) (\_ -> FailFatal err500)

  where ignoreE :: SomeException -> ()
        ignoreE = const ()

spec :: Spec
spec = do
  describe "Delayed" $ do
    it "actually runs clean up actions" $ do
      _ <- simpleRun $ delayed (return ()) (Route $ return ())
      cleanUpDone <- isJust <$> readIORef delayedTestRef
      cleanUpDone `shouldBe` False
    it "even with exceptions in serverD" $ do
      _ <- simpleRun $ delayed (return ()) (Route $ throw DivideByZero)
      cleanUpDone <- isJust <$> readIORef delayedTestRef
      cleanUpDone `shouldBe` False
    it "even with routing failure in bodyD" $ do
      _ <- simpleRun $ delayed (delayedFailFatal err500) (Route $ return ())
      cleanUpDone <- isJust <$> readIORef delayedTestRef
      cleanUpDone `shouldBe` False
    it "even with exceptions in bodyD" $ do
      _ <- simpleRun $ delayed (liftIO $ throwIO DivideByZero) (Route $ return ())
      cleanUpDone <- isJust <$> readIORef delayedTestRef
      cleanUpDone `shouldBe` False