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