Alternative/MonadPlus ActionT instances

Web/Scotty/Internal/Types.hs

@@ -3,9 +3,7 @@ module Web.Scotty.Internal.Types where
 
 import           Blaze.ByteString.Builder (Builder)
 
-#if !(MIN_VERSION_base(4,8,0))
 import           Control.Applicative
-#endif
 import qualified Control.Exception as E
 import           Control.Monad.Base (MonadBase, liftBase, liftBaseDefault)
 import           Control.Monad.Error.Class
@@ -137,6 +135,22 @@ instance (Monad m, ScottyError e) => Monad (ActionT e m) where
     ActionT m >>= k = ActionT (m >>= runAM . k)
     fail = ActionT . throwError . stringError
 
+instance ( Monad m, ScottyError e
+#if !(MIN_VERSION_base(4,8,0))
+         , Functor m
+#endif
+         ) => Alternative (ActionT e m) where
+    empty = mzero
+    (<|>) = mplus
+
+instance (Monad m, ScottyError e) => MonadPlus (ActionT e m) where
+    mzero = ActionT . ExceptT . return $ Left Next
+    ActionT m `mplus` ActionT n = ActionT . ExceptT $ do
+        a <- runExceptT m
+        case a of
+            Left  _ -> runExceptT n
+            Right r -> return $ Right r
+
 instance (MonadIO m, ScottyError e) => MonadIO (ActionT e m) where
     liftIO io = ActionT $ do
                     r <- liftIO $ liftM Right io `E.catch` (\ e -> return $ Left $ stringError $ show (e :: E.SomeException))

test/Web/ScottySpec.hs

@@ -5,6 +5,7 @@ import           Test.Hspec
 import           Test.Hspec.Wai
 import           Network.Wai (Application)
 
+import           Control.Applicative
 import           Control.Monad
 import           Data.Char
 import           Data.String
@@ -93,6 +94,12 @@ spec = do
       it "has a MonadBaseControl instance" $ do
         get "/" `shouldRespondWith` 200
 
+    withApp (Scotty.get "/dictionary" $ param "word1" <|> param "word2" >>= text) $
+      it "has an Alternative instance" $ do
+        get "/dictionary?word1=haskell"   `shouldRespondWith` "haskell"
+        get "/dictionary?word2=scotty"    `shouldRespondWith` "scotty"
+        get "/dictionary?word1=a&word2=b" `shouldRespondWith` "a"
+
     describe "param" $ do
       withApp (Scotty.matchAny "/search" $ param "query" >>= text) $ do
         it "returns query parameter with given name" $ do