{-# 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