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=b3c6d0758be3f18d379d620dbbc00034146d8362;hb=6cc54ccef706a0eba367e63c8b4248df81010f2a;hpb=24d6b6e25e79495eaa00eb6eacdb707d181d0770 diff --git a/Network/HTTP/Lucu/Resource/Dispatcher.hs b/Network/HTTP/Lucu/Resource/Dispatcher.hs index b3c6d07..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,69 +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 f - where - f ∷ CI Text → [ByteString] → IO (Maybe ([ByteString], ResourceDef)) - f _ _ = return Nothing + 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] - → Maybe ([ByteString], ResourceDef)) where - findResource = ((return ∘) ∘) +instance Dispatchable (CI Text → [ByteString] → IO (Maybe ResourceDef)) where + dispatch = ((((<$>) ∘ (<$>)) ((,) []) ∘) ∘) -instance Dispatchable (CI Text - → [ByteString] - → IO (Maybe ResourceDef)) where - findResource = ((((<$>) ∘ (<$>)) ((,) []) ∘) ∘) +instance Dispatchable (CI Text → [ByteString] → Maybe ResourceDef) where + dispatch = (((return ∘ ((,) [] <$>)) ∘) ∘) -instance Dispatchable (CI Text - → [ByteString] - → Maybe ResourceDef) where - findResource = (((return ∘ ((,) [] <$>)) ∘) ∘) +instance Dispatchable ([ByteString] → IO (Maybe ResourceDef)) where + dispatch = const ∘ (((<$>) ∘ (<$>)) ((,) []) ∘) -instance Dispatchable ([ByteString] - → IO (Maybe ([ByteString], ResourceDef))) where - findResource = const - -instance Dispatchable ([ByteString] - → Maybe ([ByteString], ResourceDef)) where - findResource = const ∘ (return ∘) - -instance Dispatchable ([ByteString] - → IO (Maybe ResourceDef)) where - findResource = const ∘ (((<$>) ∘ (<$>)) ((,) []) ∘) - -instance Dispatchable ([ByteString] - → Maybe ResourceDef) where - findResource = const ∘ ((return ∘ ((,) [] <$>)) ∘) - -instance Dispatchable (IO (Maybe ([ByteString], ResourceDef))) where - findResource = const ∘ const - -instance Dispatchable ([ByteString], ResourceDef) where - findResource = const ∘ const ∘ return ∘ Just +instance Dispatchable ([ByteString] → Maybe ResourceDef) where + 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