X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FDispatcher%2FInternal.hs;h=3699f700fd82c2413bd47b54e82d7b4ee2c8a072;hb=243b99439640480fc148d2e175247dacce04a222;hp=72589200892f3f230cdf644082da384cd16a6dae;hpb=57b93dc50655857941cc176aed2fc085e6555ff7;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Dispatcher/Internal.hs b/Network/HTTP/Lucu/Dispatcher/Internal.hs
index 7258920..3699f70 100644
--- a/Network/HTTP/Lucu/Dispatcher/Internal.hs
+++ b/Network/HTTP/Lucu/Dispatcher/Internal.hs
@@ -26,41 +26,61 @@ import Control.Applicative hiding (empty)
 import Control.Monad.Trans.Maybe
 import Control.Monad.Unicode
 import Data.Collections
+import qualified Data.Collections.Newtype.TH as C
 import qualified Data.Map as M
 import Data.Monoid
 import Data.Monoid.Unicode
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Utils
 import Network.URI hiding (path)
-import Prelude hiding (filter, lookup, null)
+import Prelude hiding (filter, foldr, lookup, null)
 import Prelude.Unicode
 
--- |FIXME: docs
+-- |Class of maps from 'Host' to 'ResourceMap' to provide name-based
+-- virtual hosts.
+--
+-- Note that Lucu currently does not implement neither RFC 2817
+-- connection upgrading (<http://tools.ietf.org/html/rfc2817>) nor RFC
+-- 3546 server name indication
+-- (<http://tools.ietf.org/html/rfc3546#section-3.1>) so you won't be
+-- able to host more than one SSL virtual host on the same port
+-- without using wildcard certificates
+-- (<http://tools.ietf.org/html/rfc2818#section-3.1>).
 --
 -- Minimal complete definition: 'findResourceMap'
 class HostMapper α where
+    -- |Find a repository of resources for the given host name if any.
     findResourceMap ∷ Host → α → MaybeT IO ResourceMap
+    -- |Wrap an instance of 'HostMapper' in a monoidal, homogeneous
+    -- container.
     hostMap ∷ α → HostMap
     {-# INLINE hostMap #-}
     hostMap = HMap
 
 -- |Container type for the 'HostMapper' type class.
-data HostMap = ∀α. HostMapper α ⇒ HMap α
+data HostMap = ∀α. HostMapper α ⇒ HMap !α
 
--- |FIXME: docs
+-- |Class of maps from resource 'Path' to 'Resource'.
 --
 -- Minimal complete definition: 'findResource'
 class ResourceMapper α where
+    -- |Find a resource handler for the given resource path, along
+    -- with the path where the said handler was found. The found path
+    -- is usually the same as the queried path, but there are
+    -- situations where the found path is just a prefix of the queried
+    -- path. See 'greedy'.
     findResource ∷ Path → α → MaybeT IO (Path, Resource)
+    -- |Wrap an instance of 'ResourceMapper' in a monoidal,
+    -- homogeneous container.
     resourceMap  ∷ α → ResourceMap
     {-# INLINE resourceMap #-}
     resourceMap = RMap
 
 -- |Container type for the 'ResourceMapper' type class.
-data ResourceMap = ∀α. ResourceMapper α ⇒ RMap α
+data ResourceMap = ∀α. ResourceMapper α ⇒ RMap !α
 
--- |'ResourceTree' is an opaque structure which is a map from resource
--- path to 'Resource'.
+-- |'ResourceTree' is an opaque structure which a map from resource
+-- 'Path' to 'ResourceNode'.
 --
 -- @
 --   'fromList' [ ([]        , 'nonGreedy' '$' 'Network.HTTP.Lucu.StaticFile.staticFile' \"\/usr\/include\/stdio.h\" ) -- \/
@@ -76,17 +96,24 @@ data ResourceMap = ∀α. ResourceMapper α ⇒ RMap α
 newtype ResourceTree = Tree (M.Map Path ResourceNode)
     deriving Monoid
 
--- |FIXME: doc
+-- |A node of 'Resource' located somewhere in a 'ResourceTree'. Such
+-- nodes are either 'greedy' or 'nonGreedy'.
 data ResourceNode
     = Greedy    { nResource ∷ !Resource }
     | NonGreedy { nResource ∷ !Resource }
 
--- |FIXME: doc
+-- |Make a greedy resource node.
+--
+-- Say a client is trying to access \"\/aaa\/bbb\/ccc\' while there is
+-- no resource node at the path. If there are greedy resource nodes at
+-- \"\/aaa\/bbb\", \"\/aaa\" or \"/\" they will be chosen instead as a
+-- fallback. Greedy resource nodes are searched in depth-first
+-- order, just like CGI scripts.
 greedy ∷ Resource → ResourceNode
 {-# INLINE CONLIKE greedy #-}
 greedy = Greedy
 
--- |FIXME: doc
+-- |Make a normal, non-greedy resource node.
 nonGreedy ∷ Resource → ResourceNode
 {-# INLINE CONLIKE nonGreedy #-}
 nonGreedy = NonGreedy
@@ -204,6 +231,13 @@ canonPath ∷ (Collection c f, Foldable f e) ⇒ c → c
 {-# INLINEABLE canonPath #-}
 canonPath = filter ((¬) ∘ null)
 
+C.derive [d| instance Foldable ResourceTree (Path, ResourceNode)
+           |]
+
+instance Collection ResourceTree (Path, ResourceNode) where
+    {-# INLINE filter #-}
+    filter f (Tree m) = Tree $ filter f m
+
 -- |'findResource' performs the longest prefix match on the tree,
 -- finding the most specific one.
 instance ResourceMapper ResourceTree where