-- CGI program to check a Cabal package without storing it

module Main (main) where

import Data.Char		( toLower )
import Distribution.PackageDescription
				( GenericPackageDescription(..), package )
import Distribution.Text	( display )
import Network.CGI		( runCGI, handleErrors,
				  getVarWithDefault, getInputFilename,
				  getInputFPS, outputError, liftIO, output,
				  setHeader )
import Text.XHtml		( Html, renderHtml, (!), (<<), h2, paragraph,
				  thediv, identifier,
				  ulist, li, emphasize, toHtml )

import HackagePage		( haddockPage )
import PackagePage		( getPkgBody )
import Unpack			( unpackPackage )
import Util

main :: IO ()
main = runCGI $ handleErrors $ do
	-- package field is a filename, of the form <package>-<version>.tar.gz
	mb_tarFile <- getInputFilename "package"
	mb_contents <- getInputFPS "package"
	case (mb_tarFile, mb_contents) of
	    (Just tarFile, Just contents) -> do
		res <- liftIO $ unpackPackage (basename tarFile) contents False
		case res of
		    Left err -> do
			outputError 400 "Error in upload" [err]
		    Right (pkg, warnings) -> do
			-- If the caller accepts only text/plain (e.g. the
			-- command-line client), only send the warnings.
			accept <- getVarWithDefault "HTTP_ACCEPT" "text/html"
			if map toLower accept == "text/plain"
			    then do
				setHeader "Content-type" "text/plain"
				output (unlines warnings)
			    else do
				-- Otherwise return a preview page to client
				page <- liftIO $ previewPage pkg warnings
				output $ renderHtml page
	    _ -> outputError 400 "malformed URL" []

-- Generate a preview of the package page
previewPage :: GenericPackageDescription -> [String] -> IO Html
previewPage pkg warnings = do
	preview <- getPkgBody pkg
	-- Put it all together
	return $ haddockPage "package check and preview" $
		(thediv ! [identifier "content"] << report) : preview
  where report =
		(h2 << "Package check and preview") :
		(paragraph << ("Package " ++ display pkgId ++ " contains no fatal errors.")) :
		(if null warnings then [] else
		 [paragraph << "However the package generated the following warnings:", ulist << map (li <<) warnings]) ++
		[paragraph << [
			toHtml "A preview of the package page is below.  To add the package to the database, use the upload form on the ",
			emphasize << "Upload",
			toHtml " page."]]
	pkgId = package (packageDescription pkg)