Instantiate ArrowChoice for Compiler

1 files changed, 6 insertions, 1 deletions

diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index ccdd557..6737b6a 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -20,7 +20,7 @@ import Control.Monad ((<=<), liftM2)
 import Data.Set (Set)
 import qualified Data.Set as S
 import Control.Category (Category, (.), id)
-import Control.Arrow (Arrow, arr, first)
+import Control.Arrow (Arrow, ArrowChoice, arr, first, left)
 
 import Hakyll.Core.Identifier
 import Hakyll.Core.ResourceProvider
@@ -78,6 +78,11 @@ instance Arrow Compiler where
         x' <- j x
         return (x', y)
 
+instance ArrowChoice Compiler where
+    left (Compiler d j) = Compiler d $ \e -> case e of
+        Left l  -> Left  <$> j l
+        Right r -> Right <$> return r
+
 -- | Run a compiler, yielding the resulting target and it's dependencies
 --
 runCompilerJob :: Compiler () a     -- ^ Compiler to run