From f353e89d11fed83068106fac8b4f8124879fb17c Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Wed, 15 Feb 2012 14:58:30 +0900
Subject: [PATCH] adding Applicative & Alternative.

---
 AA.hs | 42 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)
 create mode 100644 AA.hs

diff --git a/AA.hs b/AA.hs
new file mode 100644
index 0000000..f919c40
--- /dev/null
+++ b/AA.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module AA where
+
+import Control.Applicative
+import Control.Exception
+import Control.Monad
+import CoreMonad
+import Data.Typeable
+import Exception
+import GHC
+
+----------------------------------------------------------------
+
+instance Applicative Ghc where
+    pure  = return
+    (<*>) = ap
+
+instance Alternative Ghc where
+  empty = goNext
+  x <|> y = x `gcatch` (\(_ :: SomeException) -> y)
+
+----------------------------------------------------------------
+
+{-| Go to the next 'Ghc' monad by throwing 'AltGhcgoNext'.
+-}
+goNext :: Ghc a
+goNext = liftIO $ throwIO AltGhcgoNext
+
+{-| Run any one 'Ghc' monad.
+-}
+runAnyOne :: [Ghc a] -> Ghc a
+runAnyOne = foldr (<|>) goNext
+
+----------------------------------------------------------------
+
+{-| Exception to control 'Alternative' 'Ghc'.
+-}
+data AltGhcgoNext = AltGhcgoNext deriving (Show, Typeable)
+
+instance Exception AltGhcgoNext