Split Choose into two different effects

src/Run.purs

@@ -47,7 +47,7 @@ import Data.Symbol (SProxy(..)) as Exports
 import Data.Symbol (SProxy(..), class IsSymbol)
 import Data.Tuple (Tuple(..), curry, uncurry)
 import Partial.Unsafe (unsafeCrashWith)
-import Run.Internal (_choose, CHOOSE, Choose(..), toRows, fromRows)
+import Run.Internal (_choose, CHOOSE, Choose(..), _empty, EMPTY, Empty(..), toRows, fromRows)
 import Type.Equality (class TypeEquals)
 import Prim.Row as Row
 import Type.Row (RProxy)
@@ -345,10 +345,13 @@ instance runMonadAff ∷ (TypeEquals (RProxy r1) (RProxy (aff ∷ AFF, effect 
 liftChoose ∷ ∀ r a. Choose a → Run (choose ∷ CHOOSE | r) a
 liftChoose = lift _choose
 
+liftEmpty :: forall r a. Empty a -> Run (empty :: EMPTY | r) a
+liftEmpty = lift _empty
+
 instance runAlt ∷ (TypeEquals (RProxy r1) (RProxy (choose ∷ CHOOSE | r2))) ⇒ Alt (Run r1) where
   alt a b = fromRows $ liftChoose (Alt identity) >>= if _ then toRows a else toRows b
 
-instance runPlus ∷ (TypeEquals (RProxy r1) (RProxy (choose ∷ CHOOSE | r2))) ⇒ Plus (Run r1) where
-  empty = fromRows $ liftChoose Empty
+instance runPlus ∷ (TypeEquals (RProxy r1) (RProxy (choose :: CHOOSE, empty ∷ EMPTY | r2))) ⇒ Plus (Run r1) where
+  empty = fromRows $ liftEmpty Empty
 
-instance runAlternative ∷ (TypeEquals (RProxy r1) (RProxy (choose ∷ CHOOSE | r2))) ⇒ Alternative (Run r1)
+instance runAlternative ∷ (TypeEquals (RProxy r1) (RProxy (choose ∷ CHOOSE, empty :: EMPTY | r2))) ⇒ Alternative (Run r1)

src/Run/Choose.purs

@@ -1,14 +1,13 @@
 module Run.Choose
   ( liftChoose
-  , cempty
   , calt
   , runChoose
   , module Run.Internal
   ) where
 
 import Prelude
 
-import Control.Alternative (class Alternative, alt, empty )
+import Control.Alt (class Alt, alt)
 import Data.Either (Either(..))
 import Run (Run)
 import Run as Run
@@ -17,20 +16,16 @@ import Run.Internal (Choose(..), CHOOSE, _choose)
 liftChoose ∷ ∀ r a. Choose a → Run (choose ∷ CHOOSE | r) a
 liftChoose = Run.lift _choose
 
-cempty ∷ ∀ r a. Run (choose ∷ CHOOSE | r) a
-cempty = empty
-
 calt ∷ ∀ r a. Run (choose ∷ CHOOSE | r) a → Run (choose ∷ CHOOSE | r) a → Run (choose ∷ CHOOSE | r) a
 calt = alt
 
-runChoose ∷ ∀ f a r. Alternative f ⇒ Run (choose ∷ CHOOSE | r) a → Run r (f a)
+runChoose ∷ ∀ f a r. Alt f => Applicative f ⇒ Run (choose ∷ CHOOSE | r) a → Run r (f a)
 runChoose = loop
   where
   handle = Run.on _choose Left Right
   loop r = case Run.peel r of
     Left a → case handle a of
       Left a' → case a' of
-        Empty → pure empty
         Alt k → do
           x ← loop (k true)
           y ← loop (k false)

src/Run/Empty.purs

@@ -0,0 +1,25 @@
+module Run.Empty where
+
+import Prelude
+
+import Control.Plus (class Plus, empty)
+import Data.Either (Either(..))
+import Run (Run)
+import Run as Run
+import Run.Internal (Empty(..), EMPTY, _empty)
+
+liftEmpty :: forall r a. Empty a -> Run (empty :: EMPTY | r) a
+liftEmpty = Run.lift _empty
+
+runEmpty :: forall f a r. Applicative f => Plus f => Run (empty :: EMPTY | r) a -> Run r (f a)
+runEmpty = loop
+  where
+  handle = Run.on _empty Left Right
+  loop r = case Run.peel r of
+    Left a -> case handle a of
+      Left a' -> case a' of
+        Empty -> pure empty
+      Right a' ->
+        Run.send a' >>= loop
+    Right a ->
+      pure (pure a)

src/Run/Internal.purs

@@ -2,6 +2,9 @@ module Run.Internal
   ( Choose(..)
   , CHOOSE
   , _choose
+  , Empty(..)
+  , EMPTY
+  , _empty
   , toRows
   , fromRows
   ) where
@@ -14,8 +17,7 @@ import Type.Row (RProxy)
 import Unsafe.Coerce (unsafeCoerce)
 
 data Choose a
-  = Empty
-  | Alt (Boolean → a)
+  = Alt (Boolean → a)
 
 derive instance functorChoose ∷ Functor Choose
 
@@ -24,6 +26,15 @@ type CHOOSE = FProxy Choose
 _choose ∷ SProxy "choose"
 _choose = SProxy
 
+data Empty a = Empty
+
+derive instance functorEmpty :: Functor Empty
+
+type EMPTY = FProxy Empty
+
+_empty :: SProxy "empty"
+_empty = SProxy
+
 toRows
   ∷ ∀ f r1 r2 a
   . TypeEquals (RProxy r1) (RProxy r2)

test/Main.purs

@@ -10,7 +10,9 @@ import Effect (Effect)
 import Effect.Console (logShow, log)
 import Run (EFFECT, FProxy, Run, SProxy(..), lift, liftEffect, on, extract, runBaseEffect, run, send)
 import Run.Choose (CHOOSE, runChoose)
+import Run.Empty (runEmpty)
 import Run.Except (EXCEPT, catch, runExcept, runExceptAt, throw, throwAt)
+import Run.Internal (EMPTY)
 import Run.Reader (READER, ask, runReader)
 import Run.State (STATE, get, gets, modify, put, putAt, runState, runStateAt)
 import Run.Writer (WRITER, runWriter, tell)
@@ -91,7 +93,7 @@ yesProgram = do
   whileM_ mb ma = flip tailRecM unit \a →
     mb >>= if _ then ma $> Loop unit else pure $ Done unit
 
-chooseProgram ∷ ∀ r. Run (choose ∷ CHOOSE, effect ∷ EFFECT | r) Int
+chooseProgram ∷ ∀ r. Run (choose ∷ CHOOSE, effect :: EFFECT, empty :: EMPTY | r) Int
 chooseProgram = do
   n ← oneOfMap pure [1, 2, 3, 4, 5]
   liftEffect $ log $ show n
@@ -145,6 +147,8 @@ main = do
 
   as ← chooseProgram
     # runChoose
+    # runEmpty
+    # map join
     # runBaseEffect
   logShow (as ∷ Array Int)