diff options
author | Kazu Yamamoto <kazu@iij.ad.jp> | 2013-02-01 11:59:24 +0900 |
---|---|---|
committer | Kazu Yamamoto <kazu@iij.ad.jp> | 2013-02-01 11:59:24 +0900 |
commit | 8d4c94ca5a969a5ebbb791939fb0195dc672429e (patch) | |
tree | 560a944a7105cd715f9acba46790bd7e1a77f82f /html-test/accept.lhs | |
parent | 266a20afd2d27f28bbb62839ebc3f70bd83bfcce (diff) | |
parent | 3d25ea2929a9a9bd0768339b8ac5fd1b7c4670ad (diff) |
Merge branch 'ghc-7.6' into ghc-7.6-merge-2
Conflicts:
haddock.cabal
src/Haddock/Interface/AttachInstances.hs
src/Haddock/Interface/Create.hs
src/Haddock/Interface/LexParseRn.hs
src/Haddock/InterfaceFile.hs
src/Haddock/Types.hs
Only GHC HEAD can compile this. GHC 7.6.x cannot compile this.
Some test fail.
Diffstat (limited to 'html-test/accept.lhs')
-rwxr-xr-x | html-test/accept.lhs | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/html-test/accept.lhs b/html-test/accept.lhs new file mode 100755 index 00000000..f6dfc4cd --- /dev/null +++ b/html-test/accept.lhs @@ -0,0 +1,49 @@ +#!/usr/bin/env runhaskell +\begin{code} +{-# LANGUAGE CPP #-} +import System.Cmd +import System.Environment +import System.FilePath +import System.Directory +import Data.List +import Control.Applicative + +baseDir = takeDirectory __FILE__ + +main :: IO () +main = do + contents <- filter (not . ignore) <$> getDirectoryContents (baseDir </> "out") + args <- getArgs + if not $ null args then + mapM_ copy [ baseDir </> "out" </> file | file <- contents, ".html" `isSuffixOf` file, takeBaseName file `elem` args ] + else + mapM_ copy [ baseDir </> "out" </> file | file <- contents] + where + ignore = + foldr (liftA2 (||)) (const False) [ + (== ".") + , (== "..") + , (isPrefixOf "index") + , (isPrefixOf "doc-index") + ] + +copy :: FilePath -> IO () +copy file = do + let new = baseDir </> "ref" </> takeFileName file + if ".html" `isSuffixOf` file then do + putStrLn (file ++ " -> " ++ new) + stripLinks <$> readFile file >>= writeFile new + else do + -- copy css, images, etc. + copyFile file new + +stripLinks :: String -> String +stripLinks str = + let prefix = "<a href=\"" in + case stripPrefix prefix str of + Just str' -> prefix ++ stripLinks (dropWhile (/= '"') str') + Nothing -> + case str of + [] -> [] + x : xs -> x : stripLinks xs +\end{code} |