{-# LANGUAGE
    OverloadedStrings
  , QuasiQuotes
  , UnicodeSyntax
  #-}
import qualified Data.ByteString.Lazy.Char8 as Lazy
import Control.Applicative
import qualified Data.Collections as C
import Control.Monad.Unicode
import Data.Default
import Data.Maybe
import Data.Monoid.Unicode
import Network
import Network.HTTP.Lucu
import Prelude hiding (head)
import Prelude.Unicode
import Text.Blaze hiding (text)
import Text.Blaze.Html5 hiding (text)
import Text.Blaze.Html5.Attributes hiding (form, title)
import Text.Blaze.Renderer.Utf8

main ∷ IO ()
main = let config = def { cnfServerPort = "9999" }
           tree   ∷ ResourceTree
           tree   = C.fromList [ ([], nonGreedy resMain) ]
       in
         do putStrLn "Access http://localhost:9999/ with your browser."
            withSocketsDo ∘ runHttpd config $ resourceMap tree

resMain ∷ Resource
resMain = C.fromList
          [ ( GET
            , do setContentType [mimeType| text/html; charset="UTF-8" |]
                 putBuilder
                     $ renderHtmlBuilder
                     $ docTypeHtml ! lang "en"
                     $ do head $ do meta ! charset "UTF-8"
                                    title "Multipart Form Test"
                          body $ form ! action  "/"
                                      ! method  "post"
                                      ! enctype "multipart/form-data"
                               $ do toHtml ("Upload some file:" ∷ String)
                                    input ! type_ "text"   ! name  "text"
                                    input ! type_ "file"   ! name  "file"
                                    input ! type_ "submit" ! value "Submit"
            )
          , ( POST
            , do f ← getForm Nothing
                 let text     = fromMaybe (∅) $ fdContent <$> lookup "text" f
                     file     = fromMaybe (∅) $ fdContent <$> lookup "file" f
                     fileName = fdFileName =≪ lookup "file" f
                 setContentType [mimeType| 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"
            )
          ]