X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=55c2166aba9d438cf689ee6e949c851c733d547a;hb=667baf9f664ccc093241287ad727b2839290f456;hp=4c59b3e9f8b1ac5a1524d634d2595a339c80c853;hpb=1ead053df6a792edafa9d714c4c038a8a9c3ad16;p=Lucu.git

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 4c59b3e..55c2166 100644
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -14,6 +14,7 @@ import Control.Concurrent
 import Control.Concurrent.STM
 import Control.Exception hiding (block)
 import Control.Monad
+import Control.Monad.Trans.Maybe
 import qualified Data.Attoparsec.Lazy as LP
 import qualified Data.ByteString as Strict
 import qualified Data.ByteString.Lazy as Lazy
@@ -25,13 +26,13 @@ import qualified Data.Text as T
 import Network.HTTP.Lucu.Abortion
 import Network.HTTP.Lucu.Config
 import Network.HTTP.Lucu.Chunk
+import Network.HTTP.Lucu.Dispatcher.Internal
 import Network.HTTP.Lucu.HandleLike
 import Network.HTTP.Lucu.Interaction
 import Network.HTTP.Lucu.Preprocess
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
 import Network.HTTP.Lucu.Resource.Internal
-import Network.HTTP.Lucu.Resource.Tree
 import Network.HTTP.Lucu.Utils
 import Network.Socket
 import Prelude.Unicode
@@ -40,8 +41,7 @@ import System.IO (hPutStrLn, stderr)
 data Context h
     = Context {
         cConfig    ∷ !Config
-      , cResTree   ∷ !ResTree
-      , cFallbacks ∷ ![FallbackHandler]
+      , cSchemeMap ∷ !SchemeMap
       , cHandle    ∷ !h
       , cPort      ∷ !PortNumber
       , cAddr      ∷ !SockAddr
@@ -55,16 +55,15 @@ data ChunkReceivingState
 
 requestReader ∷ HandleLike h
               ⇒ Config
-              → ResTree
-              → [FallbackHandler]
+              → SchemeMap
               → h
               → PortNumber
               → SockAddr
               → InteractionQueue
               → IO ()
-requestReader cnf tree fbs h port addr tQueue
+requestReader cnf sm h port addr tQueue
     = do input ← hGetLBS h
-         acceptRequest (Context cnf tree fbs h port addr tQueue) input
+         acceptRequest (Context cnf sm h port addr tQueue) input
       `catches`
       [ Handler handleAsyncE
       , Handler handleOthers
@@ -113,7 +112,7 @@ acceptParsableRequest ctx@(Context {..}) req input
          if isError $ arInitialStatus ar then
              acceptSemanticallyInvalidRequest ctx ar input
          else
-             do rsrc ← findResource cResTree cFallbacks $ reqURI $ arRequest ar
+             do rsrc ← runMaybeT $ dispatch (reqURI $ arRequest ar) cSchemeMap
                 case rsrc of
                   Nothing
                       → do let ar' = ar {