, runResource
)
where
-import Control.Arrow
+import Control.Arrow
import Control.Applicative
import Data.Ascii (Ascii)
import qualified Data.Ascii as A
-import Control.Concurrent
-import Control.Concurrent.STM
-import Control.Exception
-import Control.Monad
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Exception
+import Control.Monad
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Encoding as LT
-import Data.List
+import Data.List
import qualified Data.Map as M
-import Data.Map (Map)
-import Data.Maybe
+import Data.Map (Map)
+import Data.Maybe
import Data.Monoid.Unicode
-import Network.HTTP.Lucu.Abortion
-import Network.HTTP.Lucu.Config
-import Network.HTTP.Lucu.Headers (fromHeaders)
-import Network.HTTP.Lucu.Request
-import Network.HTTP.Lucu.Resource
-import Network.HTTP.Lucu.Response
-import Network.HTTP.Lucu.Interaction
-import Network.HTTP.Lucu.Utils
-import Network.URI hiding (path)
-import System.IO
-import Prelude hiding (catch)
+import Network.HTTP.Lucu.Abortion
+import Network.HTTP.Lucu.Config
+import Network.HTTP.Lucu.DefaultPage
+import Network.HTTP.Lucu.Headers (fromHeaders)
+import Network.HTTP.Lucu.Request
+import Network.HTTP.Lucu.Resource
+import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Interaction
+import Network.HTTP.Lucu.Utils
+import Network.URI hiding (path)
+import System.IO
+import Prelude hiding (catch)
import Prelude.Unicode
-- , ([\"unistd\"], 'Network.HTTP.Lucu.StaticFile.staticFile' \"\/usr\/include\/unistd.h\") -- \/unistd
-- ]
-- @
+--
+-- Note that the request path in an incoming HTTP request is always
+-- treated as an URI-encoded UTF-8 string.
mkResTree ∷ [ ([Text], ResourceDef) ] → ResTree
mkResTree = processRoot ∘ map (first canonicalisePath)
where
if state ≤ DecidingHeader then
flip runRes itr $
do setStatus $ aboStatus abo
+ setHeader "Content-Type" defaultPageContentType
mapM_ (uncurry setHeader) $ fromHeaders $ aboHeaders abo
- output $ LT.encodeUtf8 $ abortPage itrConfig itrRequest res abo
+ putChunk $ LT.encodeUtf8 $ abortPage itrConfig itrRequest res abo
else
when (cnfDumpTooLateAbortionToStderr itrConfig)
- $ hPutStrLn stderr $ show abo
+ $ dumpAbortion abo
runRes (driftTo Done) itr
+
+dumpAbortion ∷ Abortion → IO ()
+dumpAbortion abo
+ = hPutStr stderr
+ $ concat [ "Lucu: an exception occured after "
+ , "sending response header to the client:\n"
+ , " ", show abo, "\n"
+ ]