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