From: PHO Date: Fri, 6 Jan 2012 04:39:58 +0000 (+0900) Subject: Slightly changed the definition of Router arrow. X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;ds=sidebyside;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