From 8b1f6d3debcb67e6f6e8fc5d547e79792ee481ca Mon Sep 17 00:00:00 2001
From: KingoftheHomeless <combiner8761@gmail.com>
Date: Fri, 19 Jul 2019 02:50:22 +0200
Subject: [PATCH] Added nonDetToError (#179)

---
 src/Polysemy/NonDet.hs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/src/Polysemy/NonDet.hs b/src/Polysemy/NonDet.hs
index 04aa9bd..65ed5aa 100644
--- a/src/Polysemy/NonDet.hs
+++ b/src/Polysemy/NonDet.hs
@@ -8,11 +8,14 @@ module Polysemy.NonDet
     -- * Interpretations
   , runNonDet
   , runNonDetMaybe
+  , nonDetToError
   ) where
 
 import Control.Applicative
 import Control.Monad.Trans.Maybe
 import Data.Maybe
+import Polysemy
+import Polysemy.Error
 import Polysemy.Internal
 import Polysemy.Internal.NonDet
 import Polysemy.Internal.Union
@@ -96,3 +99,20 @@ runNonDetMaybe (Sem sem) = Sem $ \k -> runMaybeT $ sem $ \u ->
           id
           x
 {-# INLINE runNonDetMaybe #-}
+
+------------------------------------------------------------------------------
+-- | Transform a 'NonDet' effect into an @'Error' e@ effect,
+-- through providing an exception that 'empty' may be mapped to.
+--
+-- This allows '<|>' to handle 'throw's of the @'Error' e@ effect.
+nonDetToError :: Member (Error e) r
+              => e
+              -> Sem (NonDet ': r) a
+              -> Sem r a
+nonDetToError (e :: e) = interpretH $ \case
+  Empty -> throw e
+  Choose left right -> do
+    left'  <- nonDetToError e <$> runT left
+    right' <- nonDetToError e <$> runT right
+    raise (left' `catch` \(_ :: e) -> right')
+{-# INLINE nonDetToError #-}