Slightly changed the definition of Router arrow.

[Lucu.git] / Network / HTTP / Lucu / Router.hs

diff --git a/Network/HTTP/Lucu/Router.hs b/Network/HTTP/Lucu/Router.hs
index f04441baf0b8fbdf9b40b0f69d87bbc3c25dd0d4..b643797ee960c17e14dab6c0ef2f8809685ea88f 100644 (file)
--- 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