X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource%2FDispatcher.hs;h=13080ee1da3a0e9fe32bca44152e6375cb774a58;hp=aadd39bce5a827f2b1da84b37c047e60acfee21f;hb=6cc54ccef706a0eba367e63c8b4248df81010f2a;hpb=850ea02dbd575b4fa1720a8b0592fede6a1e6050 diff --git a/Network/HTTP/Lucu/Resource/Dispatcher.hs b/Network/HTTP/Lucu/Resource/Dispatcher.hs index aadd39b..13080ee 100644 --- a/Network/HTTP/Lucu/Resource/Dispatcher.hs +++ b/Network/HTTP/Lucu/Resource/Dispatcher.hs @@ -19,10 +19,10 @@ import Prelude.Unicode -- |FIXME: docs class Dispatchable α where - findResource ∷ α - → CI Text - → [ByteString] - → IO (Maybe ([ByteString], ResourceDef)) + dispatch ∷ α + → CI Text + → [ByteString] + → IO (Maybe ([ByteString], ResourceDef)) dispatcher ∷ α → Dispatcher {-# INLINE dispatcher #-} @@ -32,41 +32,46 @@ class Dispatchable α where data Dispatcher = ∀α. Dispatchable α ⇒ Dispatcher α instance Dispatchable Dispatcher where - findResource (Dispatcher α) = findResource α + dispatch (Dispatcher α) = dispatch α dispatcher = id -- |FIXME: doc instance Monoid Dispatcher where {-# INLINE mempty #-} - mempty = dispatcher (return Nothing ∷ IO (Maybe ResourceDef)) + mempty = dispatcher () {-# INLINEABLE mappend #-} mappend (Dispatcher α) (Dispatcher β) = dispatcher - $ \host path → do r ← findResource α host path + $ \host path → do r ← dispatch α host path case r of Just _ → return r - Nothing → findResource β host path + Nothing → dispatch β host path instance Dispatchable (CI Text → [ByteString] → IO (Maybe ([ByteString], ResourceDef))) where - findResource = id + dispatch = id instance Dispatchable (CI Text → [ByteString] → IO (Maybe ResourceDef)) where - findResource = ((((<$>) ∘ (<$>)) ((,) []) ∘) ∘) + dispatch = ((((<$>) ∘ (<$>)) ((,) []) ∘) ∘) instance Dispatchable (CI Text → [ByteString] → Maybe ResourceDef) where - findResource = (((return ∘ ((,) [] <$>)) ∘) ∘) + dispatch = (((return ∘ ((,) [] <$>)) ∘) ∘) instance Dispatchable ([ByteString] → IO (Maybe ResourceDef)) where - findResource = const ∘ (((<$>) ∘ (<$>)) ((,) []) ∘) + dispatch = const ∘ (((<$>) ∘ (<$>)) ((,) []) ∘) instance Dispatchable ([ByteString] → Maybe ResourceDef) where - findResource = const ∘ ((return ∘ ((,) [] <$>)) ∘) + dispatch = const ∘ ((return ∘ ((,) [] <$>)) ∘) instance Dispatchable (IO (Maybe ResourceDef)) where - findResource = const ∘ const ∘ ((<$>) ∘ (<$>)) ((,) []) + dispatch = const ∘ const ∘ ((<$>) ∘ (<$>)) ((,) []) +-- |The constant dispatcher returning always the same 'ResourceDef'. instance Dispatchable ResourceDef where - findResource = const ∘ const ∘ return ∘ Just ∘ (,) [] + dispatch = const ∘ const ∘ return ∘ Just ∘ (,) [] + +-- |The empty dispatcher returning always 'Nothing'. +instance Dispatchable () where + dispatch _ _ _ = return Nothing \ No newline at end of file