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 qualified Data.Collections as C
   8 import Control.Monad.Unicode
   9 import Data.Maybe
  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            tree   ∷ ResourceTree
  18            tree   = C.fromList [ ([], nonGreedy resMain) ]
  19        in
  20          do putStrLn "Access http://localhost:9999/ with your browser."
  21             withSocketsDo ∘ runHttpd config $ resourceMap tree
  22
  23 resMain ∷ Resource
  24 resMain = C.fromList
  25           [ ( GET
  26             , do setContentType $ parseMIMEType "text/html"
  27                  putChunks $ "<title>Multipart Form Test</title>\n"
  28                            ⊕ "<form action=\"/\" method=\"post\" enctype=\"multipart/form-data\">\n"
  29                            ⊕ "  Upload some file:\n"
  30                            ⊕ "  <input type=\"text\" name=\"text\">\n"
  31                            ⊕ "  <input type=\"file\" name=\"file\">\n"
  32                            ⊕ "  <input type=\"submit\" value=\"Submit\">\n"
  33                            ⊕ "</form>\n"
  34             )
  35           , ( POST
  36             , do form ← getForm Nothing
  37                  let text     = fromMaybe (∅) $ fdContent <$> lookup "text" form
  38                      file     = fromMaybe (∅) $ fdContent <$> lookup "file" form
  39                      fileName = fdFileName =≪ lookup "file" form
  40                  setContentType $ parseMIMEType "text/plain"
  41                  putChunks $ "You entered \"" ⊕ text ⊕ "\".\n"
  42                  putChunks $ "You uploaded a " ⊕ Lazy.pack (show $ Lazy.length file) ⊕ " bytes long file.\n"
  43                  putChunks $ "The file name is " ⊕ Lazy.pack (show fileName) ⊕ ".\n"
  44             )
  45           ]