X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=examples%2FMultipart.hs;h=8ddc6189be39a8ad942d372671819fd6f066e53f;hb=ece223c516e66223ef1d5d8e6bbe4054a235d983;hp=e68bb396e5b292814845f7849af70995f0f35546;hpb=50e8fe7af585a8d33d93b3721be8f8f01905b891;p=Lucu.git diff --git a/examples/Multipart.hs b/examples/Multipart.hs index e68bb39..8ddc618 100644 --- a/examples/Multipart.hs +++ b/examples/Multipart.hs @@ -1,35 +1,41 @@ -import Data.List +{-# LANGUAGE + OverloadedStrings + , UnicodeSyntax + #-} +import qualified Data.ByteString.Lazy.Char8 as Lazy +import Control.Applicative +import Control.Monad.Unicode import Data.Maybe -import Network +import Data.Monoid.Unicode import Network.HTTP.Lucu -main :: IO () -main = let config = defaultConfig { cnfServerPort = PortNumber 9999 } +main ∷ IO () +main = let config = defaultConfig { cnfServerPort = "9999" } resources = mkResTree [ ([], resMain) ] in do putStrLn "Access http://localhost:9999/ with your browser." runHttpd config resources [] -resMain :: ResourceDef +resMain ∷ ResourceDef resMain - = ResourceDef { - resUsesNativeThread = False - , resIsGreedy = False - , resGet - = Just $ do setContentType $ read "text/html" - output ("Multipart Form Test" ++ - "
" ++ - " Enter some value:" ++ - " " ++ - " " ++ - "
") - , resHead = Nothing + = emptyResource { + resGet + = Just $ do setContentType $ parseMIMEType "text/html" + putChunks $ "Multipart Form Test\n" + ⊕ "
\n" + ⊕ " Upload some file:\n" + ⊕ " \n" + ⊕ " \n" + ⊕ " \n" + ⊕ "
\n" , resPost - = Just $ do form <- inputForm defaultLimit - let value = fromMaybe "" $ fmap snd $ find ((== "val") . fst) form - setContentType $ read "text/plain" - output ("You entered: " ++ value) - , resPut = Nothing - , resDelete = Nothing - } \ No newline at end of file + = Just $ do form ← getForm Nothing + let text = fromMaybe (∅) $ fdContent <$> lookup "text" form + file = fromMaybe (∅) $ fdContent <$> lookup "file" form + fileName = fdFileName =≪ lookup "file" form + setContentType $ parseMIMEType "text/plain" + putChunks $ "You entered \"" ⊕ text ⊕ "\".\n" + putChunks $ "You uploaded a " ⊕ Lazy.pack (show $ Lazy.length file) ⊕ " bytes long file.\n" + putChunks $ "The file name is " ⊕ Lazy.pack (show fileName) ⊕ ".\n" + }