]> gitweb @ CieloNegro.org - Lucu.git/blob - Network/HTTP/Lucu/Resource/Dispatcher.hs
b3c6d0758be3f18d379d620dbbc00034146d8362
[Lucu.git] / Network / HTTP / Lucu / Resource / Dispatcher.hs
1 {-# LANGUAGE
2     ExistentialQuantification
3   , FlexibleInstances
4   , UnicodeSyntax
5   #-}
6 -- |FIXME: doc
7 module Network.HTTP.Lucu.Resource.Dispatcher
8     ( Dispatchable(..)
9     , Dispatcher
10     )
11     where
12 import Control.Applicative
13 import Data.ByteString (ByteString)
14 import Data.CaseInsensitive (CI)
15 import Data.Monoid
16 import Data.Text (Text)
17 import Network.HTTP.Lucu.Resource.Internal
18 import Prelude.Unicode
19
20 -- |FIXME: docs
21 class Dispatchable α where
22     findResource ∷ α
23                  → CI Text
24                  → [ByteString]
25                  → IO (Maybe ([ByteString], ResourceDef))
26
27     dispatcher ∷ α → Dispatcher
28     {-# INLINE dispatcher #-}
29     dispatcher = Dispatcher
30
31 -- |FIXME: doc
32 data Dispatcher = ∀α. Dispatchable α ⇒ Dispatcher α
33
34 instance Dispatchable Dispatcher where
35     findResource (Dispatcher α) = findResource α
36     dispatcher = id
37
38 -- |FIXME: doc
39 instance Monoid Dispatcher where
40     {-# INLINE mempty #-}
41     mempty = dispatcher f
42         where
43           f ∷ CI Text → [ByteString] → IO (Maybe ([ByteString], ResourceDef))
44           f _ _ = return Nothing
45
46     {-# INLINEABLE mappend #-}
47     mappend (Dispatcher α) (Dispatcher β)
48         = dispatcher
49           $ \host path → do r ← findResource α host path
50                             case r of
51                               Just _  → return r
52                               Nothing → findResource β host path
53
54 instance Dispatchable (CI Text
55                        → [ByteString]
56                        → IO (Maybe ([ByteString], ResourceDef))) where
57     findResource = id
58
59 instance Dispatchable (CI Text
60                        → [ByteString]
61                        → Maybe ([ByteString], ResourceDef)) where
62     findResource = ((return ∘) ∘)
63
64 instance Dispatchable (CI Text
65                        → [ByteString]
66                        → IO (Maybe ResourceDef)) where
67     findResource = ((((<$>) ∘ (<$>)) ((,) []) ∘) ∘)
68
69 instance Dispatchable (CI Text
70                        → [ByteString]
71                        → Maybe ResourceDef) where
72     findResource = (((return ∘ ((,) [] <$>)) ∘) ∘)
73
74 instance Dispatchable ([ByteString]
75                        → IO (Maybe ([ByteString], ResourceDef))) where
76     findResource = const
77
78 instance Dispatchable ([ByteString]
79                        → Maybe ([ByteString], ResourceDef)) where
80     findResource = const ∘ (return ∘)
81
82 instance Dispatchable ([ByteString]
83                        → IO (Maybe ResourceDef)) where
84     findResource = const ∘ (((<$>) ∘ (<$>)) ((,) []) ∘)
85
86 instance Dispatchable ([ByteString]
87                        → Maybe ResourceDef) where
88     findResource = const ∘ ((return ∘ ((,) [] <$>)) ∘)
89
90 instance Dispatchable (IO (Maybe ([ByteString], ResourceDef))) where
91     findResource = const ∘ const
92
93 instance Dispatchable ([ByteString], ResourceDef) where
94     findResource = const ∘ const ∘ return ∘ Just
95
96 instance Dispatchable (IO (Maybe ResourceDef)) where
97     findResource = const ∘ const ∘ ((<$>) ∘ (<$>)) ((,) [])
98
99 instance Dispatchable ResourceDef where
100     findResource = const ∘ const ∘ return ∘ Just ∘ (,) []