It (at least) builds now...

[Lucu.git] / Network / HTTP / Lucu / RequestReader.hs

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 4c59b3e9f8b1ac5a1524d634d2595a339c80c853..55c2166aba9d438cf689ee6e949c851c733d547a 100644 (file)
--- 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.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
 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.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.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
 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
 data Context h
     = Context {
         cConfig    ∷ !Config

-      , cResTree   ∷ !ResTree
-      , cFallbacks ∷ ![FallbackHandler]
+      , cSchemeMap ∷ !SchemeMap

       , cHandle    ∷ !h
       , cPort      ∷ !PortNumber
       , cAddr      ∷ !SockAddr
       , cHandle    ∷ !h
       , cPort      ∷ !PortNumber
       , cAddr      ∷ !SockAddr


@@ -55,16 +55,15 @@ data ChunkReceivingState
 
 requestReader ∷ HandleLike h
               ⇒ Config
 
 requestReader ∷ HandleLike h
               ⇒ Config

-              → ResTree
-              → [FallbackHandler]
+              → SchemeMap

               → h
               → PortNumber
               → SockAddr
               → InteractionQueue
               → IO ()
               → h
               → PortNumber
               → SockAddr
               → InteractionQueue
               → IO ()

-requestReader cnf tree fbs h port addr tQueue
+requestReader cnf sm h port addr tQueue

     = do input ← hGetLBS h
     = 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
       `catches`
       [ Handler handleAsyncE
       , Handler handleOthers


@@ -113,7 +112,7 @@ acceptParsableRequest ctx@(Context {..}) req input
          if isError $ arInitialStatus ar then
              acceptSemanticallyInvalidRequest ctx ar input
          else
          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 {
                 case rsrc of
                   Nothing
                       → do let ar' = ar {