-insertNodeAt ∷ (Functor m, MonadIO m)
- ⇒ [PathSegment]
- → ResourceNode m
- → ResourceNode m
- → ResourceNode m
-{-# INLINEABLE insertNodeAt #-}
-insertNodeAt [] a b = a ⊕ b
-insertNodeAt (x:[]) a b = Branch (singleton (x, a)) ⊕ b
-insertNodeAt (x:xs) a b = insertNodeAt xs a (∅) ⊕ b
-
-instance (Functor m, MonadIO m) ⇒ Monoid (ResourceNode m) where
- {-# INLINE mempty #-}
- mempty = Branch (∅)
- {-# INLINEABLE mappend #-}
- mappend _ (Greedy r ) = Greedy r
- mappend (Greedy _ ) (NonGreedy r n) = NonGreedy r n
- mappend (NonGreedy _ m) (NonGreedy r n) = NonGreedy r (m ⊕ n)
- mappend (Branch m) (NonGreedy r n) = NonGreedy r (m ⊕ n)
- mappend (Greedy r ) (Branch _) = Greedy r
- mappend (NonGreedy r m) (Branch 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