[Pkg-haskell-commits] darcs: haskell-devscripts: Not support gzip file and stripPrefix

[kiwamu at debian.or.jp]

Tue Oct  2 14:32:38 UTC 2012  kiwamu at debian.or.jp
  * Not support gzip file and stripPrefix
  Ignore-this: d9140ccfa66618877804075a5624bcf

    M ./haddock-collect.hs -11 +12

Tue Oct  2 14:32:38 UTC 2012  kiwamu at debian.or.jp
  * Not support gzip file and stripPrefix
  Ignore-this: d9140ccfa66618877804075a5624bcf
diff -rN -u old-haskell-devscripts//haddock-collect.hs new-haskell-devscripts//haddock-collect.hs
--- old-haskell-devscripts//haddock-collect.hs	2012-10-04 13:13:47.930300186 +0000
+++ new-haskell-devscripts//haddock-collect.hs	2012-10-04 13:13:47.954720610 +0000
@@ -3,11 +3,12 @@
 
 import Data.List
 import Data.Char
+import Data.Maybe
 import System.Environment
 import System.FilePath
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString.Lazy.Char8 as BL8
-import Codec.Compression.GZip
+--import qualified Data.ByteString.Lazy as BL
+--import qualified Data.ByteString.Lazy.Char8 as BL8
+--import Codec.Compression.GZip
 
 type URL = String
 
@@ -33,22 +34,22 @@
 
 readFileGz :: FilePath -> IO String
 readFileGz file
-  | takeExtension file == ".gz" = do
-    c <- BL.readFile file
-    return $ BL8.unpack . decompress $ c
+--  | takeExtension file == ".gz" = do
+--    c <- BL.readFile file
+--    return $ BL8.unpack . decompress $ c
   | otherwise = readFile file
 
-readAndPrint :: URL -> FilePath -> FilePath -> IO ()
-readAndPrint prefix outdir file = do
+readAndPrint :: URL -> String -> FilePath -> FilePath -> IO ()
+readAndPrint prefix strip outdir file = do
   f <- readFileGz file
   writeFile outfile $ filterHaddock url f
     where dropgz f | takeExtension f == ".gz" = dropExtension f
                    | otherwise                = f
           outfile = outdir </> takeFileName (dropgz file)
-          url = prefix ++ dropFileName file
+          url = prefix ++ (fromMaybe "" . stripPrefix strip . dropFileName $ file)
 
 main :: IO ()
 main = do
-  [p, o] <- getArgs
+  [p, s, o] <- getArgs
   c <- getContents
-  mapM_ (readAndPrint p o) (lines c)
+  mapM_ (readAndPrint p s o) (lines c)