hask-home 2006.3.23 → 2007.12.6
raw patch · 3 files changed
+122/−93 lines, 3 filesdep +directorydep +hmarkupdep +networkdep −haskell98dep ~Cabaldep ~basedep ~xhtmlnew-uploader
Dependencies added: directory, hmarkup, network, process, regex-compat
Dependencies removed: haskell98
Dependency ranges changed: Cabal, base, xhtml
Files
- bump-version.hs +0/−31
- hask-home.cabal +19/−9
- hask-home.hs +103/−53
− bump-version.hs
@@ -1,31 +0,0 @@-#!/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.cabal view
@@ -1,20 +1,30 @@ Name: hask-home-Version: 2006.3.23+Version: 2007.12.6+Cabal-version: >= 1.2+Build-type: Simple Copyright: Bjorn Bringert 2006 Maintainer: bjorn@bringert.net Author: Bjorn Bringert-Homepage: http://www.cs.chalmers.se/~bringert/darcs/hask-tags/doc/+Homepage: http://www.cs.chalmers.se/~bringert/darcs/hask-home/doc/ License: BSD3-Build-depends: haskell98, base, Cabal, xhtml 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+Flag split-base -Executable: hask-home-upload-Main-Is: hask-home-upload.hs-ghc-options: -O2+Executable hask-home+ Main-Is: hask-home.hs+ Build-depends: Cabal >= 1.2, regex-compat, network, hmarkup >= 3000.0.1, xhtml >= 3000.0.2.1+ if flag(split-base)+ Build-depends: base >= 3.0, process, directory+ else+ Build-depends: base < 3.0++Executable hask-home-upload+ Main-Is: hask-home-upload.hs+ if flag(split-base)+ Build-depends: base >= 3.0, process+ else+ Build-depends: base < 3.0
hask-home.hs view
@@ -1,5 +1,9 @@ #!/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@@ -8,30 +12,44 @@ import Distribution.PackageDescription import Distribution.Simple import Distribution.Simple.Utils+import Distribution.Verbosity+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"-haddockDirRel = "api" downloadDir = "download"-haddockDir = docDir ++ "/" ++ haddockDirRel+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"]+ "haskell98","posix","html"] +-- 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",("NewCGI","http://www.cs.chalmers.se/~bringert/darcs/haskell-cgi/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 $@@ -45,21 +63,37 @@ ".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'- let haddockOutputDir = "dist/doc/html"+ showExceptions $ withArgs ["haddock","-v"] $ defaultMainNoRead desc rawSystem "rm" ["-rf", haddockDir]- rawSystem "cp" ["-r", haddockOutputDir, 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 @@ -69,6 +103,23 @@ 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@@ -77,8 +128,8 @@ let f = downloadDir ++ "/" ++ distFile desc renameFile (distFile desc) f -makeIndex :: PackageDescription -> String -> Html-makeIndex desc setupProg = (header << hdr) +++ (body << bdy)+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/"],@@ -86,18 +137,19 @@ ] t = pkgName (package desc) ++ " - " ++ synopsis desc bdy = [h1 << t, des, api, dow, req, ins, mai, lic, foo]- des = section "Description" [primHtml (description desc)]- api | not (needsHaddock desc) = noHtml+ des = section "Description" [primHtml readme]+ api | not (isLibrary desc) = noHtml | otherwise = section "API Documentation" - [p << hlink (haddockDirRel ++ "/" ++ "index.html")+ [p << linkFile desc (haddockDir ++ "/" ++ "index.html") << "Haddock-generated API documentation"]- repo = reverse $ drop (length docDir) $ dropWhile (=='/') $ reverse $ homepage desc- tarball = "../" ++ downloadDir ++ "/" ++ distFile desc dow = section "Download" - ((if null repo then [] else - [h3 << "Darcs", pre << ("$ darcs get --partial " ++ repo)])- ++ [h3 << "Tarball",- p << hlink tarball (distFile desc)])+ ([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)@@ -114,16 +166,17 @@ +++ pre << [unlines ["$ runghc " ++ setupProg ++ " configure"]]), li << ("Build:" +++ pre << [unlines ["$ runghc " ++ setupProg ++ " build"]]),- li << ("Install (as root):"+ if isLibrary desc then+ li << ("Install (as root):" +++ pre << [unlines ["# runghc " ++ setupProg ++ " install"]])+ else noHtml ] ] mai = section "Maintainer" [p << maintainer desc] lic | null (licenseFile desc) = section "License" [p << show (license desc)] | otherwise = section "License" [p << ("See " - +++ (hlink ("../" ++ licenseFile desc) - << licenseFile desc)+ +++ (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" @@ -133,27 +186,16 @@ << [hr, p << [generator +++ " " +++ validXHtml +++ " " +++ validCSS]] section h xs = thediv ! [theclass "section"] << ((h2 << [h]):xs) --needsHaddock :: PackageDescription -> Bool-needsHaddock = isJust . library--txt2html :: String -> IO String-txt2html s = - do- let tmpInFile = "txt2html.txt.tmp"- tmpOutFile = "txt2html.html.tmp"- writeFile tmpInFile ("\n\n\n"++s)- rawSystem "txt2tags" ["-H","--target=xhtml","--outfile="++tmpOutFile,tmpInFile]- s' <- readFile tmpOutFile- removeFile tmpInFile- removeFile tmpOutFile- return s'+mkHtaccess :: PackageDescription -> String+mkHtaccess desc = + unlines [+ unwords["Redirect" , + uriPath $ fileURI desc (downloadDir ++ "/" ++ latestDistFile desc), + show $ fileURI desc (downloadDir ++ "/" ++ distFile desc)]+ ] -desc2html :: PackageDescription -> IO PackageDescription-desc2html desc = - do- d' <- txt2html $ description desc- return $ desc { description = d' }+isLibrary :: PackageDescription -> Bool+isLibrary = isJust . library findSetup :: IO String findSetup = do@@ -170,11 +212,19 @@ showExceptions a = catch a (\e -> print e >> throw e) main = do- packageDesc <- defaultPackageDesc- desc <- readPackageDescription packageDesc+ packageDesc <- defaultPackageDesc normal+ gDesc <- readPackageDescription normal packageDesc+ let desc = flattenPackageDescription gDesc+ hPutStrLn stderr $ "Creating " ++ docDir ++ " ..." createDirectoryIfMissing True docDir setupProg <- findSetup- when (needsHaddock desc) $ buildHaddock desc+ when (isLibrary desc) $ do hPutStrLn stderr $ "Building API documentation..."+ buildHaddock desc+ hPutStrLn stderr $ "Building tarball " ++ distFile desc ++ " ..." mkTarball desc- desc' <- desc2html desc- writeFile indexFile $ renderHtml $ makeIndex desc' setupProg+ 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