#-}
-- |The entry point of Lucu httpd.
module Network.HTTP.Lucu.Httpd
- ( FallbackHandler
- , runHttpd
+ ( runHttpd
)
where
import Control.Concurrent
import Network.BSD
import Network.Socket
import Network.HTTP.Lucu.Config
+import Network.HTTP.Lucu.Dispatcher
import Network.HTTP.Lucu.Interaction
import Network.HTTP.Lucu.RequestReader
-import Network.HTTP.Lucu.Resource.Tree
import Network.HTTP.Lucu.ResponseWriter
import Network.HTTP.Lucu.SocketLike as SL
import Prelude.Unicode
--
-- Example:
--
--- > {-# LANGUAGE OverloadedStrings #-}
--- > {-# LANGUAGE QuasiQuotes #-}
--- > module Main where
--- > import Network.HTTP.Lucu
--- >
--- > main :: IO ()
--- > main = let config = defaultConfig
--- > resources = mkResTree [ ([], helloWorld) ]
--- > in
--- > runHttpd config resourcees []
--- >
--- > helloWorld :: Resource
--- > helloWorld = emptyResource {
--- > resGet
--- > = Just $ do setContentType [mimeType| text/plain |]
--- > putChunk "Hello, world!"
--- > }
-runHttpd ∷ Config → ResTree → [FallbackHandler] → IO ()
-runHttpd cnf tree fbs
- = withSocketsDo $
- do let launchers
+-- @
+-- {-\# LANGUAGE OverloadedStrings \#-}
+-- {-\# LANGUAGE QuasiQuotes \#-}
+-- module Main where
+-- import qualified "Data.Collections" as C
+-- import "Network"
+-- import "Network.HTTP.Lucu"
+--
+-- main :: 'IO' ()
+-- main = let config = 'defaultConfig'
+-- tree :: 'ResourceTree'
+-- tree = C.fromList [ ([], 'nonGreedy' helloWorld) ]
+-- in
+-- 'Network.withSocketsDo' '.' 'runHttpd' config '$' 'resourceMap' tree
+--
+-- helloWorld :: 'Network.HTTP.Lucu.Resource'
+-- helloWorld = C.fromList
+-- [ ( 'Network.HTTP.Lucu.GET'
+-- , do 'Network.HTTP.Lucu.setContentType' ['Network.HTTP.Lucu.mimeType'| text/plain |]
+-- 'Network.HTTP.Lucu.putChunk' \"Hello, world!\"
+-- }
+-- @
+runHttpd ∷ HostMapper α ⇒ Config → α → IO ()
+runHttpd cnf hm
+ = do let launchers
= catMaybes
[ do addr ← cnfServerV4Addr cnf
return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf)
addrs ← getAddrInfo (Just hints) (Just host) (Just srv)
let addr = head addrs
bracketOnError
- (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
+ (socket (addrFamily addr)
+ (addrSocketType addr)
+ (addrProtocol addr))
sClose
(\ sock →
do setSocketOption sock ReuseAddr 1
httpLoop port so
= do (h, addr) ← SL.accept so
tQueue ← mkInteractionQueue
- readerTID ← forkIO $ requestReader cnf tree fbs h port addr tQueue
+ readerTID ← forkIO $ requestReader cnf hm h port addr tQueue
_writerTID ← forkIO $ responseWriter cnf h tQueue readerTID
httpLoop port so
waitForever ∷ IO ()
- waitForever = forever (threadDelay 1000000)
+ waitForever = forever $ threadDelay 1000000