[Pkg-haskell-commits] darcs: ghc: Copy haddock-collect script from haskell-devscripts package.

[kiwamu at debian.or.jp]

Sat Oct  6 23:22:07 UTC 2012  kiwamu at debian.or.jp
  * Copy haddock-collect script from haskell-devscripts package.
  Ignore-this: bf06cd73beb8f1921375223feeab60fa

    A ./haddock-collect

Sat Oct  6 23:22:07 UTC 2012  kiwamu at debian.or.jp
  * Copy haddock-collect script from haskell-devscripts package.
  Ignore-this: bf06cd73beb8f1921375223feeab60fa
diff -rN -u old-ghc//haddock-collect new-ghc//haddock-collect
--- old-ghc//haddock-collect	1970-01-01 00:00:00.000000000 +0000
+++ new-ghc//haddock-collect	2012-10-06 23:25:13.747729255 +0000
@@ -0,0 +1,36 @@
+#!/usr/bin/runhaskell
+{-# OPTIONS -Wall #-}
+
+import Data.List
+import Data.Maybe
+import System.Environment
+import System.FilePath
+
+type URL = String
+
+-- copy from hoogle/src/Recipe/Hackage.hs
+haddockPackageUrl :: URL -> [String] -> [String]
+haddockPackageUrl x = concatMap f
+    where f y | "@package " `isPrefixOf` y = ["@url " ++ x, y]
+              | otherwise = [y]
+-- copy end
+
+filterHaddock :: URL -> String -> String
+filterHaddock url = unlines . haddockPackageUrl url . lines
+
+readAndPrint :: FilePath -> FilePath -> FilePath -> IO ()
+readAndPrint strip outdir file = do
+  f <- readFile file
+  writeFile outfile $ filterHaddock url f
+    where outfile = outdir </> takeFileName file
+          url = normalise $ "file:/" ++ (fromMaybe "" . stripPrefix strip . dropFileName $ file)
+
+usage :: IO ()
+usage = putStrLn "Usage: echo SOMEWHERE/HOOGLE_DATABASE.txt | haddock-collect STRIP OUTDIR"
+
+main :: IO ()
+main = do
+  a <- getArgs
+  if a == [] || a == ["-h"] || length a /= 2 then usage
+    else do c <- getContents
+            mapM_ (readAndPrint (a !! 0) (a !! 1)) (lines c)