{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module Server where
import Data.Text (Text)
import Happstack.Server hiding (body)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import System.Directory
import System.IO
import Control.Monad.Trans
import Data.ByteString.UTF8
import Data.ByteString.Lazy
import Control.Concurrent
import Control.Monad.State
import ImperativeState hiding (name)
import Hex
import System.Cmd
 
serve :: Int -> IO ()
serve p = simpleHTTP nullConf{port = p} formPage
 
template :: Text -> H.Html -> Response
template title body
  = toResponse $
      H.html $
        do H.head $ do H.title (H.toHtml title)
           H.body $ do body
 
mainAction :: String -> String -> IO String
mainAction url filename
  = do cwd <- getCurrentDirectory
       let cfg
             = FullConfig{resolution = 300, outputFilename = filename,
                          inputUrl = url, runMode = ImperativeState.HTML, paper = "A4",
                          vector = False, ImperativeState.copy = Nothing, mainPath = cwd,
                          server = Nothing}
       return (hex (show cfg))
 
formPage :: ServerPart Response
formPage
  = do decodeBody (defaultBodyPolicy "/tmp/" 0 1000000 1000000)
       msum [viewForm, processForm]
  where  
        viewForm :: ServerPart Response
        viewForm
          = do method GET
               ok $
                 template "MediaWiki2LaTeX" $
                   H.form H.! A.action "/form" H.! A.enctype "multipart/form-data" H.!
                     A.method "POST"
                     $
                     do H.label H.! A.for "msg" $
                          "Please enter the URL of any Wiki article that you'd like to convert to pdf. It may take a little while to process your request - but if you're patient, your pdf will be ready to go in less than 10 minutes. We apologize for this inconvenience: our test system is running on an old machine, only capable of providing an upstream with 300 KByte/s."
                        H.input H.! A.type_ "text" H.! A.id "msg" H.! A.name "msg"
                        H.input H.! A.type_ "submit" H.! A.value "Make PDF!"
         
        processForm :: ServerPart Response
        processForm
          = do method POST
               msg <- lookBS "msg"
               fileName <- liftIO $
                             do tmpDir <- getTemporaryDirectory
                                (name, handle) <- openTempFile tmpDir "MediaWiki2LaTeX.pdf"
                                hClose handle >> removeFile name
                                act <- mainAction (toString (toStrict msg)) name
                                _ <- system ("mediawiki2latex -x " ++ act)
                                return name
               f <- serveFile (guessContentTypeM mimeTypes) fileName
               _ <- liftIO
                      (forkIO
                         (do threadDelay 600000
                             removeFile fileName))
               return f