+{-# LANGUAGE
+ FlexibleInstances
+ , MultiParamTypeClasses
+ , UnicodeSyntax
+ #-}
+module Network.HTTP.Lucu.Dispatcher.Node
+ ( ResourceNode
+ )
+ where
+import Data.Collections
+import qualified Data.Map as M
+import Data.Monoid
+import Data.Monoid.Unicode
+import Network.HTTP.Lucu.Resource.Internal
+import Network.HTTP.Lucu.Utils
+import Prelude hiding (filter, null)
+import Prelude.Unicode
+
+-- FIXME: docs
+data ResourceNode
+ = Greedy !Resource
+ | NonGreedy !Resource !SubTree
+ | Branch !SubTree
+
+type SubTree
+ = M.Map PathSegment 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)
+
+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 Foldable ResourceNode (PathSegments, ResourceNode) where
+ foldMap f = go (∅)
+ 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 (Greedy _ ) = False
+ null (NonGreedy _ _) = False
+ null (Branch m) = null m