-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 ) = f (p, Greedy r)
- go p (NonGreedy r m) = f (p, NonGreedy r (∅)) ⊕ go' p m
- 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
-
-
--- Instances of ResourceNode --------------------------------------------------
-instance Show ResourceNode where
- show (Greedy _ ) = "Greedy _"
- 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 ) _ = Greedy r
- mappend (NonGreedy r m) (Greedy _ ) = NonGreedy r m
- 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) (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