ダウンロードしたHTMLファイルからリンクを抽出するツールを作ってみました

Haskellの正規表現を試してみようと思って、ダウンロードしたHTMLファイルからリンクを抽出するツールを作ってみました。
ファイル: extlink.hs

module Main (main) where

import System.Environment (getArgs, getProgName)
import System.Exit (exitWith, ExitCode(ExitSuccess))
import System.Console.GetOpt
import System.IO (readFile)
import Control.Monad (when)
import Data.List (find, isPrefixOf)
import Text.Regex (mkRegexWithOpts, matchRegexAll, Regex)

data Flag = Help | Version | Image | Prefix String
            deriving (Show, Eq)

options :: [OptDescr Flag]
options =
  [ Option ['h'] ["help"]   (NoArg Help)   
      "display this help and exit.",
    Option [] ["version"]   (NoArg Version)
      "output version information and exit.",
    Option ['i'] ["image"]  (NoArg Image)
      "number all output lines.",
    Option ['p'] ["prefix"] (ReqArg Prefix "path")
      "set url prefix."
  ]

parseOptions :: [String] -> IO ([Flag], [String])
parseOptions args =
  case getOpt Permute options args of
    (o, n, []  ) -> return (o, n)
    (_, _, errs) -> ioError (userError (concat errs))

processDefaultOptions :: String -> [Flag] -> IO ()
processDefaultOptions prog flags = do
  when (getOption (isNoArgOption Help)    flags /= Nothing) $ usage
  when (getOption (isNoArgOption Version) flags /= Nothing) $ version
  where
    usage :: IO ()
    usage = do
      putStrLn $ usageInfo ("usage: " ++ prog ++ " [OPTION...] files...") options
      exitWith ExitSuccess
    
    version :: IO ()
    version = do
      putStrLn (prog ++ " - 0.1a")
      exitWith ExitSuccess

getOption :: (Flag -> Bool) -> [Flag] -> Maybe Flag
getOption func flags = find func flags

isNoArgOption :: Flag -> Flag -> Bool
isNoArgOption flag f = f == flag

isPrefixOption :: Flag -> Bool
isPrefixOption f =
  case f of
    Prefix path -> True
    otherwise   -> False
                     
main :: IO ()
main = do 
  prog <- getProgName
  args <- getArgs  
  (flags, files) <- parseOptions args
  processDefaultOptions prog flags
  let pat = if getOption (isNoArgOption Image) flags /= Nothing
              then imgPattern
              else hrefPattern
      fil = case getOption isPrefixOption flags of
              Just (Prefix path) -> prefixFilter path
              otherwise          -> nullFilter
  if null files
    then printPatternFromStdin pat fil
    else mapM_ (printPatternFromFile pat fil) files
  where
    hrefPattern :: Regex
    hrefPattern = mkRegexWithOpts "<a[^>]+href=\"?([^\">]+)\"[^>]*>" False False

    imgPattern :: Regex
    imgPattern = mkRegexWithOpts "<img[^>]+src=\"?([^\">]+)\"[^>]*>" False False

    nullFilter :: String -> String
    nullFilter s = s

    prefixFilter :: String -> String -> String
    prefixFilter path s
      | "/" `isPrefixOf` s = path ++ s
      | otherwise = s

    printPatternFromStdin :: Regex -> (String -> String) -> IO ()
    printPatternFromStdin pat fil = do
      s <- getContents
      mapM_ putStrLn $ map fil $ (extractAllPattern pat s)

    printPatternFromFile :: Regex -> (String -> String) -> FilePath -> IO ()
    printPatternFromFile pat fil file = do
      s <- readFile file
      mapM_ putStrLn $ map fil $ (extractAllPattern pat s)
      
extractAllPattern :: Regex -> String -> [String]
extractAllPattern pat s = 
  case matchRegexAll pat s of
    Just (_, _, after, matched) -> 
      matched ++ extractAllPattern pat after
    Nothing -> []

ファイル: Makefile

TARGET  = extlink
SOURCES = extlink.hs

HC      = ghc
HCFLAGS = -W -fno-warn-unused-matches --make

all: $(TARGET)

$(TARGET): $(SOURCES)
	$(HC) $(HCFLAGS) $< -o $@

clean:
	rm -f $(TARGET) *.o *.hi *.exe

使い方。コマンドライン引数にHTMLファイルを指定します。デフォルトではa href="..."のリンクを抽出します。-iオプションを付けると、img src="..."のリンクを抽出します。-p pathオプションを付けると、相対リンクの先頭に指定した文字列を付けます(相対リンク、絶対リンクの変換用)。

$ extlink hoge.html

オプションまわりの処理が複雑になってしまいましたが、正規表現についてはたいしたことしてません。関数extractAllPatternを再帰的に呼ぶことで、指定した文字列に含まれる全てのマッチした(部分)文字列を抽出しています。Rubyでいうところのscanみたいな感じ。
あ、そうそうGHCには、正規表現のライブラリとしてText.RegexとText.Regex.Posixのふたつがあるのですが、これってどう使い分ければいいんでしょう。Text.Regex.Posixの方は返り値にIOが付いてて使うのが面倒なので、今回はText.Regexを使ってみました。