import Control.Monad.Trans.Maybe
import Control.Monad.Unicode
import Data.Collections
+import qualified Data.Collections.Newtype.TH as C
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 Network.URI hiding (path)
-import Prelude hiding (filter, lookup, null)
+import Prelude hiding (filter, foldr, lookup, null)
import Prelude.Unicode
--- |FIXME: docs
+-- |Class of maps from 'Host' to 'ResourceMap' to provide name-based
+-- virtual hosts.
+--
+-- Note that Lucu currently does not implement neither RFC 2817
+-- connection upgrading (<http://tools.ietf.org/html/rfc2817>) nor RFC
+-- 3546 server name indication
+-- (<http://tools.ietf.org/html/rfc3546#section-3.1>) so you won't be
+-- able to host more than one SSL virtual host on the same port
+-- without using wildcard certificates
+-- (<http://tools.ietf.org/html/rfc2818#section-3.1>).
--
-- Minimal complete definition: 'findResourceMap'
class HostMapper α where
+ -- |Find a repository of resources for the given host name if any.
findResourceMap ∷ Host → α → MaybeT IO ResourceMap
+ -- |Wrap an instance of 'HostMapper' in a monoidal, homogeneous
+ -- container.
hostMap ∷ α → HostMap
{-# INLINE hostMap #-}
hostMap = HMap
-- |Container type for the 'HostMapper' type class.
data HostMap = ∀α. HostMapper α ⇒ HMap α
--- |FIXME: docs
+-- |Class of maps from resource 'Path' to 'Resource'.
--
-- Minimal complete definition: 'findResource'
class ResourceMapper α where
+ -- |Find a resource handler for the given resource path, along
+ -- with the path where the said handler was found. The found path
+ -- is usually the same as the queried path, but there are
+ -- situations where the found path is just a prefix of the queried
+ -- path. See 'greedy'.
findResource ∷ Path → α → MaybeT IO (Path, Resource)
+ -- |Wrap an instance of 'ResourceMapper' in a monoidal,
+ -- homogeneous container.
resourceMap ∷ α → ResourceMap
{-# INLINE resourceMap #-}
resourceMap = RMap
= Greedy { nResource ∷ !Resource }
| NonGreedy { nResource ∷ !Resource }
--- |FIXME: doc
+-- |Make a greedy resource node.
+--
+-- Say a client is trying to access \"\/aaa\/bbb\/ccc\' while there is
+-- no resource node at the path. If there are greedy resource nodes at
+-- \"\/aaa\/bbb\", \"\/aaa\" or \"/\" they will be chosen instead as a
+-- fallback. Greedy resource nodes are searched in depth-first order.
greedy ∷ Resource → ResourceNode
{-# INLINE CONLIKE greedy #-}
greedy = Greedy
{-# INLINEABLE canonPath #-}
canonPath = filter ((¬) ∘ null)
+C.derive [d| instance Foldable ResourceTree (Path, ResourceNode)
+ |]
+
+instance Collection ResourceTree (Path, ResourceNode) where
+ {-# INLINE filter #-}
+ filter f (Tree m) = Tree $ filter f m
+
-- |'findResource' performs the longest prefix match on the tree,
-- finding the most specific one.
instance ResourceMapper ResourceTree where