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