Haskell - 効率的なファイル処理、正規表現、ファイル名マッチング(グロブパターン照合器)

Real World Haskell
実戦で学ぶ関数型言語プログラミング
(オライリージャパン)
Bryan O'Sullivan (著) John Goerzen (著)
Don Stewart (著)
山下 伸夫 (翻訳) 伊東 勝利 (翻訳)
株式会社タイムインターメディア (翻訳)

開発環境

• OS X Mavericks - Apple(OS)
• BBEdit - Bare Bones Software, Inc., Emacs (Text Editor)
• Haskell (純粋関数型プログラミング言語)
• GHC (The Glasgow Haskell Compiler) (処理系)
• The Haskell Platform (インストール方法、モジュール等)

Real World Haskell―実戦で学ぶ関数型言語プログラミング(Bryan O'Sullivan (著)、 John Goerzen (著)、 Don Stewart (著)、山下 伸夫 (翻訳)、伊東 勝利 (翻訳)、株式会社タイムインターメディア (翻訳)、オライリージャパン)の8章(効率的なファイル処理、正規表現、ファイル名マッチング)、8.9(上手く動くコードにしよう)の練習問題 1.を解いてみる。

その他参考書籍

• すごいHaskellたのしく学ぼう!(オーム社) Miran Lipovača(著)、田中 英行、村主 崇行(翻訳)
• プログラミングHaskell (オーム社) Graham Hutton(著) 山本 和彦(翻訳)

練習問題 1.

コード(BBEdit, Emacs)

Sample.hs

{-# OPTIONS -Wall -Werror #-}
module Glob where

main :: IO ()
main = do
    mapM_ putStrLn $ map (\(s, pat) -> s ++ ", " ++ pat ++ ": " ++
                             (show $ matchesGlob s pat)) $
                         zip (repeat "haskell")
                             ["haskell", "h*", "*skell", "h?skell",
                              "[a-z]askell", "haskel", "a*", "*skel", "hskell",
                              "[a-g]askell"]


matchesGlob :: FilePath -> String -> Bool
matchesGlob "" "" = True
matchesGlob _ "*" = True
matchesGlob (x:xs) ('[':ps) =
    let (b, ys, zs) = bracket ps
        us = chars ys
    in if b
       then if x `elem` us then matchesGlob xs zs else False
       else if not (x `elem` us) then matchesGlob xs zs else False
matchesGlob (_:xs) ('?':ps) = matchesGlob xs ps
matchesGlob (x:xs) ('*':p:ps) = if x == p
                                then matchesGlob xs ps
                                else matchesGlob xs ('*':p:ps)
matchesGlob (x:xs) (p:ps) = x == p && matchesGlob xs ps
matchesGlob _ _ = False

bracket :: String -> (Bool, String, String)
bracket xs = let (ys, zs) = iter xs ""
                 b = head ys /= '!'
                 us = if b then ys else tail ys
             in (b, us, zs)

iter :: String -> String -> (String, String)
iter (']':xs) ys = (ys, xs)
iter (x:xs) ys = iter xs (ys ++ [x])
iter _ _ = undefined

chars :: String -> String
chars (x:'-':y:xs) = [x..y] ++ chars xs
chars xs = xs

入出力結果(Terminal, runghc)

$ runghc Sample.hs
haskell, haskell: True
haskell, h*: True
haskell, *skell: True
haskell, h?skell: True
haskell, [a-z]askell: True
haskell, haskel: False
haskell, a*: False
haskell, *skel: False
haskell, hskell: False
haskell, [a-g]askell: False
$