From ff68f4a2426b044441bf6a8b966c4fedd89af6ad Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Thu, 24 Nov 2011 17:16:22 +0900
Subject: [PATCH] Collection ResourceTree

Ditz-issue: e0312227f40a0fa92d4c5d69a64dad473f54389a
---
 Network/HTTP/Lucu/Dispatcher/Internal.hs | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/Network/HTTP/Lucu/Dispatcher/Internal.hs b/Network/HTTP/Lucu/Dispatcher/Internal.hs
index 88b1e16..6cb741d 100644
--- a/Network/HTTP/Lucu/Dispatcher/Internal.hs
+++ b/Network/HTTP/Lucu/Dispatcher/Internal.hs
@@ -80,7 +80,7 @@ newtype ResourceTree = Root ResourceNode
 
 -- |FIXME: docs
 data ResourceNode
-    = Greedy    !Resource
+    = Greedy    !Resource !SubTree
     | NonGreedy !Resource !SubTree
     | Branch              !SubTree
 
@@ -272,20 +272,24 @@ insertNodeAt p a b
 instance Foldable ResourceTree (PathSegments, ResourceNode) where
     foldMap f (Root n) = go (∅) n
         where
-          go p (Greedy    r  ) = f (p, Greedy r)
-          go p (NonGreedy r m) = f (p, NonGreedy r (∅)) ⊕ go' p m
+          go p (Greedy    r m) = go' p m ⊕ f (p, Greedy    r (∅))
+          go p (NonGreedy r m) = go' p m ⊕ f (p, NonGreedy r (∅))
           go p (Branch      m) = go' p m
 
           go' p = foldMap $ \(s, n') → go (p `snoc` s) n'
 
-    null (Root (Greedy    _  )) = False
+    null (Root (Greedy    _ _)) = False
     null (Root (NonGreedy _ _)) = False
     null (Root (Branch      m)) = null m
 
+instance Collection ResourceTree (PathSegments, ResourceNode) where
+    {-# INLINE filter #-}
+    filter f = fromList ∘ filter f ∘ fromFoldable
+
 
 -- Instances of ResourceNode --------------------------------------------------
 instance Show ResourceNode where
-    show (Greedy    _  ) = "Greedy _"
+    show (Greedy    _ m) = "Greedy _ " ⊕ show m
     show (NonGreedy _ m) = "NonGreedy _ " ⊕ show m
     show (Branch      m) = "Branch " ⊕ show m
 
@@ -293,11 +297,11 @@ instance Monoid ResourceNode where
     {-# INLINE mempty #-}
     mempty = Branch (∅)
     {-# INLINEABLE mappend #-}
-    mappend (Greedy    r  ) _               = Greedy    r
-    mappend (NonGreedy r m) (Greedy    _  ) = NonGreedy r      m
+    mappend (Greedy    r m) _               = Greedy    r      m
+    mappend (NonGreedy r m) (Greedy    _ n) = NonGreedy r (m ⊕ n)
     mappend (NonGreedy r m) (NonGreedy _ n) = NonGreedy r (m ⊕ n)
     mappend (NonGreedy r m) (Branch      n) = NonGreedy r (m ⊕ n)
-    mappend (Branch      _) (Greedy    r  ) = Greedy    r
+    mappend (Branch      m) (Greedy    r n) = Greedy    r (m ⊕ n)
     mappend (Branch      m) (NonGreedy r n) = NonGreedy r (m ⊕ n)
     mappend (Branch      m) (Branch      n) = Branch      (m ⊕ n)
 
-- 
2.40.0