module Control.Monad.Freer.CatchingSpec where

import           Control.Monad
import           Control.Exception
import           Control.Monad.Freer
import           Control.Monad.Freer.Catching
import           Test.Hspec

data Div a where
  Div :: Int -> Int -> Div Int

runDiv :: forall r v . Eff (Div ': r) v -> Eff r v
runDiv = interpret handler
  where
    handler :: Div a -> Eff r a
    handler (Div x y) = return $ x `div` y

data Test a where
  Succeed :: Test Int
  Fail :: Test Bool

data TestException = TestException deriving (Show, Exception, Eq)

runTest :: forall r v . (Member IO r)
        => Eff (Test ': r) v
       -> Eff r v
runTest = interpret handler
  where
    handler :: Test a -> Eff r a
    handler Succeed = return 3
    handler Fail = throw TestException

spec :: Spec
spec = do
  describe "div" $ do
    it "divides" $ do
      (run . runDiv . send $ Div 4 2) `shouldBe` 2

  describe "catching" $ do
    it "lets unexceptional values through from pure code" $ do
      result <- runM . runCatching @ArithException runDiv $
        catching @ArithException @Div (send $ Div 2 1)
      result `shouldBe` Right 2

    it "catches exceptions from pure code" $ do
      result <- runM . runCatching @ArithException runDiv $
        catching @ArithException @Div (send $ Div 2 0)
      result `shouldBe` Left DivideByZero

    it "lets unexceptional io values through" $ do
      result <- runM . runCatching @TestException runTest $
        catching @TestException @Test (send Succeed)
      result `shouldBe` Right 3

    it "catches io exceptions" $ do
      result <- runM . runCatching @TestException runTest $
        catching @TestException @Test (send Fail)
      result `shouldBe` Left TestException

    it "catches inside forM" $ do
      result <- runM . runCatching @TestException runTest $
        forM [1,2,3] $ \i -> do
          x <- catching @TestException @Test (send Fail)
          y <- case x of
            Left e -> return i
            Right v -> if v then return 1 else return 2
          z <- send Succeed
          return $ y + z
      result `shouldBe` [4,5,6]