Choice.hs

#!/usr/bin/env -S cabal run -v1
{- cabal:
build-depends: base, heftia-effects ^>= 0.7, unliftio
ghc-options: -Wall
-}
{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

module Main where

import Control.Monad (when)
import Control.Monad.Hefty (Eff, Effect, Emb, FOEs, interpretBy, liftIO, makeEffectF, runEff, (:>))
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 :: (Choice :> es, Emb IO :> es) => Eff es ()
program = do
    x <- choice
    y <- choice
    when (x && y) empty -- Discard the branch when x=y=True
    liftIO $ putStrLn $ "x=" <> show x <> ", y=" <> show y

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

-- > main
-- x=False, y=False
-- x=False, y=True
-- x=True, y=False