hask-home-2006.8.30/0000755000076500000000000000000010512645247014144 5ustar bjornwheel00000000000000hask-home-2006.8.30/bump-version.hs0000644000076500000000000000141210512645247017124 0ustar bjornwheel00000000000000#!/usr/bin/env runghc import Data.Char import Data.List import Distribution.Simple.Utils import System.Directory import System.Locale import System.Time bumpVersion v x | "version:" `isPrefixOf` map toLower x = "Version: " ++ v | otherwise = x newVersion = do t <- getClockTime >>= toCalendarTime let f = formatCalendarTime defaultTimeLocale "%Y.%m.%d" t return $ dropZero f dropZero [] = [] dropZero ('.':xs) = '.' : dropZero (dropWhile (=='0') xs) dropZero (x:xs) = x : dropZero xs main = do packageDesc <- defaultPackageDesc f <- readFile packageDesc let tmpFile = packageDesc ++ ".tmp" v <- newVersion let f' = unlines $ map (bumpVersion v) $ lines f writeFile tmpFile f' renameFile tmpFile packageDesc hask-home-2006.8.30/hask-home-upload.hs0000644000076500000000000000031610512645247017636 0ustar bjornwheel00000000000000#!/usr/bin/env runghc import System.Cmd main = do repo <- readFile "_darcs/prefs/defaultrepo" let cmd = "scp -pr doc download " ++ repo putStrLn cmd system cmd return ()hask-home-2006.8.30/hask-home.cabal0000644000076500000000000000104410512645247017003 0ustar bjornwheel00000000000000Name: hask-home Version: 2006.8.30 Copyright: Bjorn Bringert 2006 Maintainer: bjorn@bringert.net Author: Bjorn Bringert Homepage: http://www.cs.chalmers.se/~bringert/darcs/hask-home/doc/ License: BSD3 Build-depends: haskell98, base, Cabal, xhtml, network, hmarkup Synopsis: Generate homepages for cabal packages Description: This program generates simple homepages for cabalized Haskell packages. Executable: hask-home Main-Is: hask-home.hs ghc-options: -O2 Executable: hask-home-upload Main-Is: hask-home-upload.hs ghc-options: -O2 hask-home-2006.8.30/hask-home.hs0000644000076500000000000002332210512645247016356 0ustar bjornwheel00000000000000#!/usr/bin/env runghc -- Generate a homepage for a darcsized cabalized Haskell package. -- NOTE: this is very hack, making lots of assumptions and -- with crazy path stuff everywhere. I should clean this up. import Control.Exception import Control.Monad import Data.Char import Data.List import Data.Maybe import Distribution.PackageDescription import Distribution.Simple import Distribution.Simple.Utils import Network.URI import Prelude hiding (catch) import System.Directory import System.Environment import System.Exit import System.IO import System.Cmd import Text.Regex import Text.XHtml import Text.HMarkup -- These paths are all relative to the root of the darcs repo. docDir = "doc" downloadDir = "download" haddockDir = docDir ++ "/" ++ "api" indexFile = docDir ++ "/" ++ "index.html" htaccessFile = downloadDir ++ "/" ++ ".htaccess" -- packages that we don't need to list as requirements standardPackages = ["base","stm","mtl","fgl","QuickCheck", "Cabal","network","readline","unix","parsec", "haskell98","posix"] -- Packages whose homepages we know knownPackages = [("fps",("FastPackedString","http://www.cse.unsw.edu.au/~dons/fps.html")), ("Crypto",("The Haskell Cryptographic Library","http://haskell.org/crypto/")), ("HTTP",("The Haskell HTTP package","http://haskell.org/http/")), ("XmlRpc",("HaXR - the Haskell XML-RPC library","http://haskell.org/haxr/")), ("xhtml",("Text.XHtml","http://www.cs.chalmers.se/~bringert/darcs/haskell-xhtml/doc/")), ("cgi-compat",("cgi-compat","http://www.cs.chalmers.se/~bringert/darcs/cgi-compat/doc/")), ("haskelldb",("HaskellDB","http://haskelldb.sourceforge.net/")), ("parsedate",("parsedate","http://www.cs.chalmers.se/~bringert/darcs/parsedate/doc/")), ("hmarkup",("hmarkup","http://www.cs.chalmers.se/~bringert/darcs/hmarkup/doc/")) ] stylesheet = unlines $ [ "body { background-color: white; color: black; margin: 0; padding: 0; }", "h1, .footer { background-color:silver; color: black; margin: 0; border: 0 solid black; }", "h1 { border-bottom-width: thin; padding: 1em; }", ".footer { font-size: smaller; text-align:center; border-top-width: thin; padding: 0.25em 1em; }", ".footer span { padding: 0 0.25em; } ", "hr { display: none; }", ".section { padding: 0; margin: 0 5em; }" ] txt2html :: String -> IO String txt2html s = do r <- markupToHtml defaultMarkupXHtmlPrefs s case r of Left err -> fail err Right h -> return $ renderHtml h buildHaddock :: PackageDescription -> IO () buildHaddock desc = do let desc' = desc { description = synopsis desc } showExceptions $ withArgs ["haddock","-v"] $ defaultMainNoRead desc' rawSystem "rm" ["-rf", haddockDir] rawSystem "cp" ["-r", "dist/doc/html", haddockDir] return () where -- formatDesc p = p { description = format (description p) } -- where format = unlines . map formatLine . lines -- formatLine l | match "^\\s*\\*" l = "\n" ++ l -- | otherwise = l systemOrFail :: String -> IO () systemOrFail cmd = do e <- system cmd case e of ExitSuccess -> return () ExitFailure i -> do hPutStrLn stderr $ "Command failed with status " ++ show i ++ ": " ++ cmd exitWith e readFileOrNull :: FilePath -> IO String readFileOrNull f = do e <- doesFileExist f if e then readFile f else do hPutStrLn stderr $ f ++ " not found, skipping" return "" match :: String -> String -> Bool match p s = isJust $ matchRegex (mkRegex p) s distDir :: PackageDescription -> String distDir desc = showPackageId (package desc) distFile :: PackageDescription -> String distFile desc = distDir desc ++ ".tar.gz" latestDistFile :: PackageDescription -> String latestDistFile desc = pkgName (package desc) ++ "-latest.tar.gz" fileURI :: PackageDescription -> String -> URI fileURI desc f = fromJust $ (nullURI { uriPath = f }) `relativeTo` darcsURI desc linkFile :: HTML a => PackageDescription -> String -> a -> Html linkFile desc f x = hlink (show $ fileURI desc f `relativeFrom` homepageURI desc) << x -- FIXME: gigantic hack darcsURI :: PackageDescription -> URI darcsURI desc = home { uriPath = reverse $ drop (length docDir) $ dropWhile (=='/') $ reverse $ uriPath home } where home = homepageURI desc homepageURI :: PackageDescription -> URI homepageURI desc = fromMaybe (error $ "Package homepage is not a valid URI: " ++ homepage desc) $ parseURI $ homepage desc mkTarball :: PackageDescription -> IO () mkTarball desc = do system ("darcs dist --dist-name=" ++ distDir desc) createDirectoryIfMissing True downloadDir let f = downloadDir ++ "/" ++ distFile desc renameFile (distFile desc) f makeIndex :: PackageDescription -> String -> String -> Html makeIndex desc setupProg readme = (header << hdr) +++ (body << bdy) where hdr = [thetitle << t, meta ! [name "generator", content "hask-home, http://www.cs.chalmers.se/~bringert/darcs/hask-home/doc/"], style ! [thetype "text/css"] << stylesheet ] t = pkgName (package desc) ++ " - " ++ synopsis desc bdy = [h1 << t, des, api, dow, req, ins, mai, lic, foo] des = section "Description" [primHtml readme] api | not (needsHaddock desc) = noHtml | otherwise = section "API Documentation" [p << linkFile desc (haddockDir ++ "/" ++ "index.html") << "Haddock-generated API documentation"] dow = section "Download" ([h3 << "Darcs", pre << ("$ darcs get --partial " ++ show (darcsURI desc))] ++ [h3 << "Tarball", p << ("Latest release: " +++ linkFile desc (downloadDir ++ "/" ++ distFile desc) (distFile desc)), p << ("You can also use " +++ linkFile desc (downloadDir ++ "/" ++ latestDistFile desc) (latestDistFile desc) +++ " which should always redirect you to the latest release tarball.")]) req | null reqs = noHtml | otherwise = section "Requirements" [ulist << reqs] reqs = catMaybes $ map formatReq (buildDepends desc) formatReq d@(Dependency p v) | p `elem` standardPackages = Nothing | otherwise = Just $ case lookup p knownPackages of Just (n,u) -> li << hlink u n Nothing -> li << p ins = section "Installation" [olist << [li << ("Unpack the sources and enter the source directory:" +++ pre << [unlines ["$ tar -zxf " ++ distFile desc, "$ cd " ++ distDir desc]]), li << ("Configure:" +++ pre << [unlines ["$ runghc " ++ setupProg ++ " configure"]]), li << ("Build:" +++ pre << [unlines ["$ runghc " ++ setupProg ++ " build"]]), li << ("Install (as root):" +++ pre << [unlines ["# runghc " ++ setupProg ++ " install"]]) ] ] mai = section "Maintainer" [p << maintainer desc] lic | null (licenseFile desc) = section "License" [p << show (license desc)] | otherwise = section "License" [p << ("See " +++ (linkFile desc (licenseFile desc) << licenseFile desc) +++ ".")] validXHtml = thespan << hlink "http://validator.w3.org/check?uri=referer" "Validate XHTML" validCSS = thespan << hlink "http://jigsaw.w3.org/css-validator/check/referer" "Validate CSS" generator = thespan << ("Page generated by " +++ hlink "http://www.cs.chalmers.se/~bringert/darcs/hask-home/doc/" "hask-home") foo = thediv ! [theclass "footer"] << [hr, p << [generator +++ " " +++ validXHtml +++ " " +++ validCSS]] section h xs = thediv ! [theclass "section"] << ((h2 << [h]):xs) mkHtaccess :: PackageDescription -> String mkHtaccess desc = unlines [ unwords["Redirect" , uriPath $ fileURI desc (downloadDir ++ "/" ++ latestDistFile desc), show $ fileURI desc (downloadDir ++ "/" ++ distFile desc)] ] needsHaddock :: PackageDescription -> Bool needsHaddock = isJust . library findSetup :: IO String findSetup = do b <- doesFileExist "Setup.hs" if b then return "Setup.hs" else do b <- doesFileExist "Setup.lhs" if b then return "Setup.lhs" else fail "No setup program found" hlink :: HTML a => String -> a -> Html hlink u b = anchor ! [href u] << b showExceptions a = catch a (\e -> print e >> throw e) main = do packageDesc <- defaultPackageDesc desc <- readPackageDescription packageDesc hPutStrLn stderr $ "Creating " ++ docDir ++ " ..." createDirectoryIfMissing True docDir setupProg <- findSetup when (needsHaddock desc) $ do hPutStrLn stderr $ "Building API documentation..." buildHaddock desc hPutStrLn stderr $ "Building tarball " ++ distFile desc ++ " ..." mkTarball desc readme <- readFileOrNull "README" readme' <- txt2html $ if null readme then description desc else readme hPutStrLn stderr $ "Writing " ++ indexFile ++ " ..." writeFile indexFile $ renderHtml $ makeIndex desc setupProg readme' hPutStrLn stderr $ "Writing " ++ htaccessFile ++ " ..." writeFile htaccessFile $ mkHtaccess desc hask-home-2006.8.30/Setup.hs0000644000076500000000000000010510512645247015574 0ustar bjornwheel00000000000000#!/usr/bin/env runghc import Distribution.Simple main = defaultMain