examples/Multipart.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , UnicodeSyntax
   4   #-}
   5 import qualified Data.ByteString.Lazy.Char8 as Lazy
   6 import Control.Applicative
   7 import Control.Monad.Unicode
   8 import Data.Maybe
   9 import Data.Monoid.Unicode
  10 import Network.HTTP.Lucu
  11
  12 main ∷ IO ()
  13 main = let config    = defaultConfig { cnfServerPort = "9999" }
  14            resources = mkResTree [ ([], resMain) ]
  15        in
  16          do putStrLn "Access http://localhost:9999/ with your browser."
  17             runHttpd config resources []
  18
  19
  20 resMain ∷ ResourceDef
  21 resMain
  22     = emptyResource {
  23         resGet
  24           = Just $ do setContentType $ parseMIMEType "text/html"
  25                       putChunks $ "<title>Multipart Form Test</title>\n"
  26                                 ⊕ "<form action=\"/\" method=\"post\" enctype=\"multipart/form-data\">\n"
  27                                 ⊕ "  Upload some file:\n"
  28                                 ⊕ "  <input type=\"text\" name=\"text\">\n"
  29                                 ⊕ "  <input type=\"file\" name=\"file\">\n"
  30                                 ⊕ "  <input type=\"submit\" value=\"Submit\">\n"
  31                                 ⊕ "</form>\n"
  32       , resPost
  33           = Just $ do form ← getForm Nothing
  34                       let text     = fromMaybe (∅) $ fdContent <$> lookup "text" form
  35                           file     = fromMaybe (∅) $ fdContent <$> lookup "file" form
  36                           fileName = fdFileName =≪ lookup "file" form
  37                       setContentType $ parseMIMEType "text/plain"
  38                       putChunks $ "You entered \"" ⊕ text ⊕ "\".\n"
  39                       putChunks $ "You uploaded a " ⊕ Lazy.pack (show $ Lazy.length file) ⊕ " bytes long file.\n"
  40                       putChunks $ "The file name is " ⊕ Lazy.pack (show fileName) ⊕ ".\n"
  41       }