ThrowChoice.hs

import Control.Monad (when)
import Control.Monad.Hefty (Eff, Effect, Emb, FOEs, In, Throw, interpretBy, liftIO, makeEffectF, runEff, (:>))
import Control.Monad.Hefty.Except (catch, runCatch, runThrow, throw'_)
import Data.List (singleton)

data Choice :: Effect where
    Empty :: Choice m a
    Choice :: Choice m Bool
makeEffectF ''Choice

runChoice :: (FOEs es) => Eff (Choice : es) a -> Eff es [a]
runChoice = interpretBy (pure . singleton) \case
    Empty -> \_k -> pure [] -- Discard the continuation `_k`
    Choice -> \k ->
        -- Branch the non-deterministic computation by calling the continuation `k` twice.
        -- Splits into the world where `choice` returns False and the world where it returns True.
        liftA2 (<>) (k False) (k True)

program :: (FOEs es) => (Choice :> es, Emb IO :> es, Throw String `In` es) => Eff es ()
program = do
    x <- choice
    y <- choice
    runCatch @String $ throw'_ "exception" `catch` \e -> liftIO (print $ "caught: " <> e)
    when (x && y) empty -- Discard the branch when x=y=True
    liftIO $ putStrLn $ "x=" <> show x <> ", y=" <> show y

main :: IO ()
main = runEff do
    _ <- runThrow @String (runChoice program)
    pure ()

-- "caught: exception"
-- x=False, y=False
-- "caught: exception"
-- x=False, y=True
-- "caught: exception"
-- x=True, y=False
-- "caught: exception"