From: PHO Date: Fri, 6 Jan 2012 03:46:37 +0000 (+0900) Subject: New module Network.HTTP.Lucu.Router (mostly a stub for now) X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=1a8b40bc467928dc018f00a3899cbc39398b213e;p=Lucu.git New module Network.HTTP.Lucu.Router (mostly a stub for now) Ditz-issue: c80e79a2585ac20cc5ed677d70b6983a2842a81d --- diff --git a/Lucu.cabal b/Lucu.cabal index 3afe50b..6cbb16a 100644 --- a/Lucu.cabal +++ b/Lucu.cabal @@ -50,6 +50,7 @@ Flag ssl Library Build-Depends: + arrow-list == 0.2.*, ascii == 0.0.*, attempt == 0.3.*, attoparsec == 0.10.*, @@ -113,6 +114,7 @@ Library Network.HTTP.Lucu.Resource Network.HTTP.Lucu.Response Network.HTTP.Lucu.Response.StatusCode + Network.HTTP.Lucu.Router Network.HTTP.Lucu.SocketLike Network.HTTP.Lucu.StaticFile Network.HTTP.Lucu.Utils diff --git a/Network/HTTP/Lucu/Router.hs b/Network/HTTP/Lucu/Router.hs new file mode 100644 index 0000000..f04441b --- /dev/null +++ b/Network/HTTP/Lucu/Router.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE + GeneralizedNewtypeDeriving + , UnicodeSyntax + #-} +-- |FIXME: doc +module Network.HTTP.Lucu.Router + ( Router + , runRouter + ) + where +import Control.Applicative +import Control.Category +import Control.Arrow +import Control.Arrow.ArrowList +import Control.Arrow.ArrowKleisli +import Control.Arrow.List +import Control.Monad.IO.Class +import Control.Monad.Unicode +import Prelude.Unicode + +-- |FIXME: doc +newtype MonadIO m ⇒ Router m α β + = Router { + unRouter ∷ ListTArrow m α β + } + deriving ( Arrow + , ArrowKleisli m + , ArrowZero + , ArrowList + , ArrowPlus + , ArrowChoice + , ArrowApply + , Category + ) + +-- |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)