hask-home (empty) → 2006.3.23

raw patch · 5 files changed

+245/−0 lines, 5 filesdep +Cabaldep +basedep +haskell98build-type:Customsetup-changed

Dependencies added: Cabal, base, haskell98, xhtml

Files

• Setup.hs +4/−0
• bump-version.hs +31/−0
• hask-home-upload.hs +10/−0
• hask-home.cabal +20/−0
• hask-home.hs +180/−0

@@ -0,0 +1,4 @@+#!/usr/bin/env runghc++import Distribution.Simple+main = defaultMain

@@ -0,0 +1,31 @@+#!/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

@@ -0,0 +1,10 @@+#!/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 ()

@@ -0,0 +1,20 @@+Name: hask-home+Version: 2006.3.23+Copyright: Bjorn Bringert 2006+Maintainer: bjorn@bringert.net+Author: Bjorn Bringert+Homepage: http://www.cs.chalmers.se/~bringert/darcs/hask-tags/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++Executable:  hask-home-upload+Main-Is:     hask-home-upload.hs+ghc-options: -O2

@@ -0,0 +1,180 @@+#!/usr/bin/env runghc++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 Prelude hiding (catch)+import System.Directory+import System.Environment+import System.Cmd+import Text.Regex++import Text.XHtml++docDir = "doc"+haddockDirRel = "api"+downloadDir = "download"+haddockDir = docDir ++ "/" ++ haddockDirRel+indexFile = docDir ++ "/" ++ "index.html"++standardPackages = ["base","stm","mtl","fgl","QuickCheck",+                    "Cabal","network","readline","unix","parsec",+                    "haskell98","posix"]++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/"))+                ]++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; }"+ ]++buildHaddock :: PackageDescription -> IO ()+buildHaddock desc = +    do+    let desc' = desc { description = synopsis desc }+    showExceptions $ withArgs ["haddock","-v"] $ defaultMainNoRead desc'+    let haddockOutputDir = "dist/doc/html"+    rawSystem "rm" ["-rf", haddockDir]+    rawSystem "cp" ["-r", haddockOutputDir, 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++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"++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 -> Html+makeIndex desc setupProg = (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 (description desc)]+  api | not (needsHaddock desc) = noHtml+      | otherwise = section "API Documentation" +                      [p << hlink (haddockDirRel ++ "/" ++ "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)])+  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 " +                              +++ (hlink ("../" ++ 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)+++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'++desc2html :: PackageDescription -> IO PackageDescription+desc2html desc = +    do+    d' <- txt2html $ description desc+    return $ desc { description = d' }++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+       createDirectoryIfMissing True docDir+       setupProg <- findSetup+       when (needsHaddock desc) $ buildHaddock desc+       mkTarball desc+       desc' <- desc2html desc+       writeFile indexFile $ renderHtml $ makeIndex desc' setupProg