It (at least) builds now...

[Lucu.git] / Network / HTTP / Lucu / Resource / Dispatcher.hs

diff --git a/Network/HTTP/Lucu/Resource/Dispatcher.hs b/Network/HTTP/Lucu/Resource/Dispatcher.hs
deleted file mode 100644 (file)
index 029d7b2..0000000
--- a/Network/HTTP/Lucu/Resource/Dispatcher.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-{-# LANGUAGE
-    ExistentialQuantification
-  , FlexibleInstances
-  , MultiParamTypeClasses
-  , UndecidableInstances
-  , UnicodeSyntax
-  #-}
--- |FIXME: doc
-module Network.HTTP.Lucu.Resource.Dispatcher
-    ( Dispatchable(..)
-    , Dispatcher
-    , uriHost
-    , uriPathSegments
-    )
-    where
-import Data.CaseInsensitive (CI)
-import Data.Collections
-import Data.Monoid
-import Data.Text (Text)
-import Network.HTTP.Lucu.Resource.Internal
-import Network.HTTP.Lucu.Utils
-import Network.URI
-import Prelude.Unicode
-
--- |FIXME: docs
---
--- Minimal complete definition: 'dispatch'
-class Dispatchable α where
-    dispatch ∷ α → URI → IO (Maybe Resource)
-
-    dispatcher ∷ α → Dispatcher
-    {-# INLINE dispatcher #-}
-    dispatcher = Dispatcher
-
--- |Container type for 'Dispatchable' type class.
-data Dispatcher = ∀α. Dispatchable α ⇒ Dispatcher α
-
-instance Dispatchable Dispatcher where
-    dispatch (Dispatcher α) = dispatch α
-    dispatcher = id
-
--- |@insert a b@ first tries @a@, and then tries @b@. @insertMany bs
--- a@ first tries @a@, and then tries each one in @bs@ from head to
--- tail.
-instance Dispatchable α ⇒ Unfoldable Dispatcher α where
-    {-# INLINEABLE insert #-}
-    insert a (Dispatcher b)
-        = dispatcher
-          $ \uri → do r ← dispatch a uri
-                      case r of
-                        Just _  → return r
-                        Nothing → dispatch b uri
-    {-# INLINE empty #-}
-    empty = dispatcher e
-        where
-          e ∷ URI → IO (Maybe Resource)
-          {-# INLINE e #-}
-          e = return ∘ const Nothing
-    {-# INLINE singleton #-}
-    singleton = dispatcher
-
--- |@a `'mappend'` b@ first tries @a@, and then tries @b@.
-instance Monoid Dispatcher where
-    {-# INLINE mempty #-}
-    mempty = empty
-    {-# INLINE mappend #-}
-    mappend = insert
-
--- |An IO-based dispatcher.
-instance Dispatchable (URI → IO (Maybe Resource)) where
-    dispatch = id
-
--- |A pure dispatcher.
-instance Dispatchable (URI → Maybe Resource) where
-    dispatch = (return ∘)
-
--- |The constant dispatcher returning always the same 'Resource'.
-instance Dispatchable Resource where
-    dispatch = const ∘ return ∘ Just
-
--- |FIXME: doc
-uriHost ∷ URI → CI Text
-uriHost = error "FIXME"