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

diff --git a/Network/HTTP/Lucu/Dispatcher/Internal.hs b/Network/HTTP/Lucu/Dispatcher/Internal.hs
index 7258920..eea8d46 100644
--- a/Network/HTTP/Lucu/Dispatcher/Internal.hs
+++ b/Network/HTTP/Lucu/Dispatcher/Internal.hs
@@ -26,13 +26,14 @@ 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
@@ -81,7 +82,12 @@ 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.
 greedy ∷ Resource → ResourceNode
 {-# INLINE CONLIKE greedy #-}
 greedy = Greedy
@@ -204,6 +210,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