-instance Unfoldable ResourceTree (PathSegments, ResourceNode) where
- {-# INLINE insert #-}
- insert e (Root root) = Root $ insert e root
- {-# INLINE empty #-}
- empty = (∅)
-
-instance Monoid ResourceTree where
- {-# INLINE mempty #-}
- mempty = Root (∅)
- {-# INLINE mappend #-}
- mappend (Root a) (Root b)
- = Root (a ⊕ b)
-
--- Instances of ResourceNode --------------------------------------------------
-instance Unfoldable ResourceNode (PathSegments, ResourceNode) where
- {-# INLINEABLE insert #-}
- insert (p, n) = insertNodeAt (canonPath p) n
- {-# INLINE empty #-}
- empty = Branch (∅)
-
-canonPath ∷ (Collection c f, Foldable f e) ⇒ c → c
-{-# INLINEABLE canonPath #-}
-canonPath = filter ((¬) ∘ null)
-
-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 Monoid ResourceNode 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)