2 ExistentialQuantification
7 module Network.HTTP.Lucu.Resource.Dispatcher
12 import Control.Applicative
13 import Data.ByteString (ByteString)
14 import Data.CaseInsensitive (CI)
16 import Data.Text (Text)
17 import Network.HTTP.Lucu.Resource.Internal
18 import Prelude.Unicode
21 class Dispatchable α where
25 → IO (Maybe ([ByteString], ResourceDef))
27 dispatcher ∷ α → Dispatcher
28 {-# INLINE dispatcher #-}
29 dispatcher = Dispatcher
32 data Dispatcher = ∀α. Dispatchable α ⇒ Dispatcher α
34 instance Dispatchable Dispatcher where
35 dispatch (Dispatcher α) = dispatch α
39 instance Monoid Dispatcher where
41 mempty = dispatcher ()
43 {-# INLINEABLE mappend #-}
44 mappend (Dispatcher α) (Dispatcher β)
46 $ \host path → do r ← dispatch α host path
49 Nothing → dispatch β host path
51 instance Dispatchable (CI Text
53 → IO (Maybe ([ByteString], ResourceDef))) where
56 instance Dispatchable (CI Text → [ByteString] → IO (Maybe ResourceDef)) where
57 dispatch = ((((<$>) ∘ (<$>)) ((,) []) ∘) ∘)
59 instance Dispatchable (CI Text → [ByteString] → Maybe ResourceDef) where
60 dispatch = (((return ∘ ((,) [] <$>)) ∘) ∘)
62 instance Dispatchable ([ByteString] → IO (Maybe ResourceDef)) where
63 dispatch = const ∘ (((<$>) ∘ (<$>)) ((,) []) ∘)
65 instance Dispatchable ([ByteString] → Maybe ResourceDef) where
66 dispatch = const ∘ ((return ∘ ((,) [] <$>)) ∘)
68 instance Dispatchable (IO (Maybe ResourceDef)) where
69 dispatch = const ∘ const ∘ ((<$>) ∘ (<$>)) ((,) [])
71 -- |The constant dispatcher returning always the same 'ResourceDef'.
72 instance Dispatchable ResourceDef where
73 dispatch = const ∘ const ∘ return ∘ Just ∘ (,) []
75 -- |The empty dispatcher returning always 'Nothing'.
76 instance Dispatchable () where
77 dispatch _ _ _ = return Nothing