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 ∘ (,) []