]> gitweb @ CieloNegro.org - Lucu.git/blob - examples/Multipart.hs
6c15cd3a8a4ab1130737c1c770983892edb2d596
[Lucu.git] / examples / Multipart.hs
1 import Data.List
2 import Data.Maybe
3 import Network
4 import Network.HTTP.Lucu
5
6 main :: IO ()
7 main = let config    = defaultConfig { cnfServerPort = PortNumber 9999 }
8            resources = mkResTree [ ([], resMain) ]
9        in
10          do putStrLn "Access http://localhost:9999/ with your browser."
11             runHttpd config resources []
12
13
14 resMain :: ResourceDef
15 resMain 
16     = ResourceDef {
17         resUsesNativeThread = False
18       , resIsGreedy         = False
19       , resGet
20           = Just $ do setContentType $ read "text/html"
21                       output ("<title>Multipart Form Test</title>" ++
22                               "<form action=\"/\" method=\"post\" enctype=\"multipart/form-data\">" ++
23                               "  Upload some file:" ++
24                               "  <input type=\"text\" name=\"text\">" ++
25                               "  <input type=\"file\" name=\"file\">" ++
26                               "  <input type=\"submit\" value=\"Submit\">" ++
27                               "</form>")
28       , resHead   = Nothing
29       , resPost
30           = Just $ do form <- inputForm defaultLimit
31                       let text = fromMaybe "" $ fmap snd $ find ((== "text") . fst) form
32                           file = fromMaybe "" $ fmap snd $ find ((== "file") . fst) form
33                       setContentType $ read "text/plain"
34                       outputChunk ("You entered \"" ++ text ++ "\".\n")
35                       output ("You uploaded a " ++ show (length file) ++ " bytes long file.\n")
36       , resPut    = Nothing
37       , resDelete = Nothing
38       }