aboutsummaryrefslogblamecommitdiff
path: root/html-test/accept.lhs
blob: f6dfc4cd3207b9e60c7c4e5d32a40689ae45ca21 (plain) (tree)
1
2
3
4
5
6
7
8
9

                         

                         
                       
                          
 
                                
             
         
                                                                                
                 
                         
                                                                                                                           
      
                                                               
       




                                         
       
 
                         
              
                                                   




                                                  
 
                              






                                                               
          
#!/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}