-insertNodeAt ∷ PathSegments → ResourceNode → ResourceNode → ResourceNode
-{-# INLINEABLE insertNodeAt #-}
-insertNodeAt p a b
- = case front p of
- Nothing → a ⊕ b
- Just (x, xs)
- | null xs → Branch (singleton (x, a)) ⊕ b
- | otherwise → insertNodeAt xs a (∅) ⊕ b
-
-instance Foldable ResourceTree (PathSegments, ResourceNode) where
- foldMap f (Root n) = go (∅) n
- where
- 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 (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 _ m) = "Greedy _ " ⊕ show m
- show (NonGreedy _ m) = "NonGreedy _ " ⊕ show m
- show (Branch m) = "Branch " ⊕ show m
-
-instance Monoid ResourceNode where
- {-# INLINE mempty #-}
- mempty = Branch (∅)
- {-# INLINEABLE mappend #-}
- 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 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)
+-- |'findResource' performs the longest prefix match on the tree,
+-- finding the most specific one.
+instance ResourceMapper ResourceTree where
+ {-# INLINEABLE findResource #-}
+ findResource p (Tree m)
+ = case lookup p m of
+ Just n → return (p, nResource n)
+ Nothing → findGreedyResource p m
+
+findGreedyResource ∷ (Monad m, Map α PathSegments ResourceNode)
+ ⇒ PathSegments
+ → α
+ → MaybeT m (PathSegments, Resource)
+findGreedyResource p m
+ = case back p of
+ Nothing → fail (⊥)
+ Just (p', _) → case lookup p' m of
+ Just (Greedy r)
+ → return (p', r)
+ _ → findGreedyResource p' m