examples/HelloWorld.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , QuasiQuotes
   4   , UnicodeSyntax
   5   #-}
   6 import Control.Applicative
   7 import Control.Monad.Unicode
   8 import qualified Data.ByteString.Lazy.Char8 as Lazy
   9 import qualified Data.Collections as C
  10 import Data.Default
  11 import Data.Monoid.Unicode
  12 import Network
  13 import Network.HTTP.Lucu
  14 import Prelude.Unicode
  15
  16 main ∷ IO ()
  17 main = let config    = def { cnfServerPort = "9999" }
  18            mapper    = resourceMap resources ⊕ resourceMap fallbacks
  19            resources ∷ ResourceTree
  20            resources = C.fromList
  21                        [ ([]          , nonGreedy helloWorld)
  22                        , (["urandom" ], nonGreedy $ staticFile "/dev/urandom")
  23                        , (["inc"     ], greedy    $ staticDir  "/usr/include")
  24                        , (["inc", "t"], nonGreedy $ staticFile "/usr/include/time.h")
  25                        ]
  26            fallbacks ∷ Path → Maybe (Path, Resource)
  27            fallbacks path
  28                | path ≡ ["hello"] = Just (path, helloWorld)
  29                | otherwise        = Nothing
  30        in
  31          do putStrLn "Access http://localhost:9999/ with your browser."
  32             withSocketsDo $ runHttpd config mapper
  33
  34 helloWorld ∷ Resource
  35 helloWorld = C.fromList
  36              [ ( GET
  37                , do setContentType [mimeType| text/hello |]
  38                     putChunk "Hello, "
  39                     putChunk "World!\n"
  40                     putChunks =≪ Lazy.pack <$> getRemoteAddr'
  41                )
  42              , ( POST
  43                , do str1 ← getChunk 3
  44                     str2 ← getChunk 3
  45                     str3 ← getChunk 3
  46                     setContentType [mimeType| text/hello |]
  47                     putChunks $ Lazy.fromChunks ["[", str1, " - ", str2, "#", str3, "]"]
  48                )
  49              ]