examples/HelloWorld.hs

   1 import Control.Monad.Trans
   2 import Data.Maybe
   3 import Network
   4 import Network.HTTP.Lucu.Config
   5 import Network.HTTP.Lucu.ETag
   6 import Network.HTTP.Lucu.Httpd
   7 import Network.HTTP.Lucu.MIMEType
   8 import Network.HTTP.Lucu.MIMEType.Guess
   9 import Network.HTTP.Lucu.Parser
  10 import Network.HTTP.Lucu.Parser.Http
  11 import Network.HTTP.Lucu.Resource
  12 import Network.HTTP.Lucu.Resource.Tree
  13 import Network.HTTP.Lucu.Response
  14 import Network.HTTP.Lucu.StaticFile
  15 import Network.URI
  16 import System.Posix.Signals
  17 import System.Time
  18
  19 main :: IO ()
  20 main = let config    = defaultConfig { cnfServerPort = PortNumber 9999 }
  21            resources = mkResTree [ ( []
  22                                    , helloWorld )
  23
  24                                  , ( ["index.html"]
  25                                    , staticFile "/Users/admin/Sites/index.html" )
  26
  27                                  , ( ["urandom"]
  28                                    , staticFile "/dev/urandom" )
  29
  30                                  , ( ["inc"]
  31                                    , staticDir "/usr/include" )
  32                                  ]
  33        in
  34          do installHandler sigPIPE Ignore Nothing
  35             runHttpd config resources
  36
  37
  38 helloWorld :: ResourceDef
  39 helloWorld
  40     = ResourceDef {
  41         resUsesNativeThread = False
  42       , resIsGreedy         = False
  43       , resGet
  44           = Just $ do --time <- liftIO $ getClockTime
  45                       --foundEntity (strongETag "abcde") time
  46                       setContentType $ "text" +/+ "hello"
  47                       outputChunk "Hello, "
  48                       outputChunk "World!\n"
  49       , resHead   = Nothing
  50       , resPost
  51           = Just $ do str1 <- inputChunk 3
  52                       str2 <- inputChunk 3
  53                       str3 <- inputChunk 3
  54                       setContentType $ "text" +/+ "hello"
  55                       output ("[" ++ str1 ++ " - " ++ str2 ++ "#" ++ str3 ++ "]")
  56       , resPut    = Nothing
  57       , resDelete = Nothing
  58       }