]> gitweb @ CieloNegro.org - Lucu.git/blob - examples/Multipart.hs
Done.
[Lucu.git] / examples / Multipart.hs
1 {-# LANGUAGE
2     OverloadedStrings
3   , QuasiQuotes
4   , UnicodeSyntax
5   #-}
6 import qualified Data.ByteString.Lazy.Char8 as Lazy
7 import Control.Applicative
8 import qualified Data.Collections as C
9 import Control.Monad.Unicode
10 import Data.Default
11 import Data.Maybe
12 import Data.Monoid.Unicode
13 import Network
14 import Network.HTTP.Lucu
15 import Prelude hiding (head)
16 import Prelude.Unicode
17 import Text.Blaze hiding (text)
18 import Text.Blaze.Html5 hiding (text)
19 import Text.Blaze.Html5.Attributes hiding (form, title)
20 import Text.Blaze.Renderer.Utf8
21
22 main ∷ IO ()
23 main = let config = def { cnfServerPort = "9999" }
24            tree   ∷ ResourceTree
25            tree   = C.fromList [ ([], nonGreedy resMain) ]
26        in
27          do putStrLn "Access http://localhost:9999/ with your browser."
28             withSocketsDo ∘ runHttpd config $ resourceMap tree
29
30 resMain ∷ Resource
31 resMain = C.fromList
32           [ ( GET
33             , do setContentType [mimeType| text/html; charset="UTF-8" |]
34                  putBuilder
35                      $ renderHtmlBuilder
36                      $ docTypeHtml ! lang "en"
37                      $ do head $ do meta ! charset "UTF-8"
38                                     title "Multipart Form Test"
39                           body $ form ! action  "/"
40                                       ! method  "post"
41                                       ! enctype "multipart/form-data"
42                                $ do toHtml ("Upload some file:" ∷ String)
43                                     input ! type_ "text"   ! name  "text"
44                                     input ! type_ "file"   ! name  "file"
45                                     input ! type_ "submit" ! value "Submit"
46             )
47           , ( POST
48             , do f ← getForm Nothing
49                  let text     = fromMaybe (∅) $ fdContent <$> lookup "text" f
50                      file     = fromMaybe (∅) $ fdContent <$> lookup "file" f
51                      fileName = fdFileName =≪ lookup "file" f
52                  setContentType [mimeType| text/plain |]
53                  putChunks $ "You entered \"" ⊕ text ⊕ "\".\n"
54                  putChunks $ "You uploaded a " ⊕ Lazy.pack (show $ Lazy.length file) ⊕ " bytes long file.\n"
55                  putChunks $ "The file name is " ⊕ Lazy.pack (show fileName) ⊕ ".\n"
56             )
57           ]