From: PHO <pho@cielonegro.org>
Date: Fri, 6 Jan 2012 04:39:58 +0000 (+0900)
Subject: Slightly changed the definition of Router arrow.
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=d0865cb266d25b6f3e07a34c10a3a04fc0405db8;p=Lucu.git

Slightly changed the definition of Router arrow.

Ditz-issue: c80e79a2585ac20cc5ed677d70b6983a2842a81d
---

diff --git a/Network/HTTP/Lucu/Router.hs b/Network/HTTP/Lucu/Router.hs
index f04441b..b643797 100644
--- a/Network/HTTP/Lucu/Router.hs
+++ b/Network/HTTP/Lucu/Router.hs
@@ -11,22 +11,20 @@ module Network.HTTP.Lucu.Router
 import Control.Applicative
 import Control.Category
 import Control.Arrow
-import Control.Arrow.ArrowList
 import Control.Arrow.ArrowKleisli
 import Control.Arrow.List
+import Data.Maybe
 import Control.Monad.IO.Class
-import Control.Monad.Unicode
 import Prelude.Unicode
 
 -- |FIXME: doc
-newtype MonadIO m ⇒ Router m α β
+newtype Router m α β
     = Router {
         unRouter ∷ ListTArrow m α β
       }
     deriving ( Arrow
              , ArrowKleisli m
              , ArrowZero
-             , ArrowList
              , ArrowPlus
              , ArrowChoice
              , ArrowApply
@@ -35,10 +33,5 @@ newtype MonadIO m ⇒ Router m α β
 
 -- |FIXME: doc
 runRouter ∷ (Applicative m, MonadIO m) ⇒ Router m α β → α → m (Maybe β)
-{-# INLINEABLE runRouter #-}
-runRouter = ((optional' =≪) ∘) ∘ runListTArrow ∘ unRouter
-    where
-      optional' ∷ Applicative f ⇒ [β] → f (Maybe β)
-      {-# INLINE optional' #-}
-      optional' []    = pure Nothing
-      optional' (x:_) = pure (Just x)
+{-# INLINE runRouter #-}
+runRouter = ((listToMaybe <$>) ∘) ∘ runListTArrow ∘ unRouter