Real World Haskell
実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan, John Goerzen, Don Stewart(著)
山下 伸夫, 伊東 勝利
株式会社タイムインターメディア(翻訳)
開発環境
- OS X Lion - Apple(OS)
- BBEdit - Bare Bones Software, Inc.(Text Editor)
- プログラミング言語: Haskell (純粋関数型)
Real World Haskell』(Bryan O'Sullivan、John Goerzen、Don Stewart(著)、山下 伸夫、伊東 勝利、株式会社タイムインターメディア(翻訳)、オライリー・ジャパン、2009年、ISBN978-4-87311-423-3)の8章(効率的なファイル処理、正規表現、ファイル名マッチング)の8.7(作成したパターン照合器を使う)の練習問題2.を解いてみる。
2.
おそらくdoesNameExistの代用になる関数はSystem.Posix.Filesモジュール(本書ではSystem.Posix.FilePathモジュールとなっているけどおそらく誤植?Haskell Hierarchical Librariesでそういう名前のモジュールは見つからなかった。なのでReal World Haskell(原書)のサポートページみたいのを探していると、Chapter 8. Efficient file processing, regular expressions, and file name matchingを発見。そこではSystem.Posix.Filesとなってた。)のfileExist関数っぽい。(Haskell Hierarchical Libraries、System.Posix.Files、Checking file existence and permissionsのfileExistを参照。)求めている機能もdoexNameExistと一致するし、型も同じだから。
ということで、System.Posix.FilesモジュールのfileExistでdoesNameExistを書き換えてみる。
コード(BBEdit)
Glob.hs
-- file: Glob.hs module Glob (namesMatching) where import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, getDirectoryContents) import System.FilePath (dropTrailingPathSeparator, splitFileName, (</>), pathSeparator) import System.Posix.Files (fileExist) -- Control.Exceptionだと上手くいかなかったのでOldExceptionに修正 -- ただし、将来のバージョンでは使えなくなるみたい(その旨が警告された) -- かといって、今のところ修正方法が分からない。。 import Control.OldException (handle) import Control.Monad (forM) import GlobRegex (matchesGlob) isPattern :: String -> Bool isPattern = any (`elem`"[*?") namesMatching pat | not (isPattern pat) = do -- 書き換えた箇所 exists <- fileExist pat return (if exists then [pat] else []) | otherwise = do case splitFileName pat of ("", baseName) -> do curDir <- getCurrentDirectory listMatches curDir baseName (dirName, baseName) -> do dirs <- if isPattern dirName then namesMatching (dropTrailingPathSeparator dirName) else return [dirName] let listDir = if isPattern baseName then listMatches else listPlain pathNames <- forM dirs $ \dir -> do baseNames <- listDir dir baseName return (map (dir </>) baseNames) return (concat pathNames) {- doesNameExist :: FilePath -> IO Bool doesNameExist name = do fileExists <- doesFileExist name if fileExists then return True else doesDirectoryExist name -} listMatches :: FilePath -> String -> IO [String] listMatches dirName pat = do dirName' <- if null dirName then getCurrentDirectory else return dirName handle (const (return [])) $ do names <- getDirectoryContents dirName' let names' = if isHidden pat then filter isHidden names else filter (not . isHidden) names -- ここのpathSeparatorでUNIXかWindowsか判定 let i = if pathSeparator == '/' then True else False return (filter (matchesGlob i pat) names') isHidden :: String -> Bool isHidden ('.':_) = True isHidden _ = False listPlain :: FilePath -> String -> IO [String] listPlain dirName baseName = do exists <- if null baseName then doesDirectoryExist dirName -- 書き換えた箇所 else fileExist (dirName </> baseName) return (if exists then [baseName] else [])
GlobRegex.hsは以前の投稿、Haskell - グロブパターンを正規表現に翻訳する(大文字小文字の区別) | Kamimura's blogのと同じ。
入出力結果(Terminal, ghci)
$ ghci GHCi, version 7.4.2: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Prelude> :load Glob [1 of 2] Compiling GlobRegex ( GlobRegex.hs, interpreted ) [2 of 2] Compiling Glob ( Glob.hs, interpreted ) Glob.hs:11:1: Warning: Module `Control.OldException' is deprecated: Future versions of base will not support the old exceptions style. Please switch to extensible exceptions. Glob.hs:11:30: Warning: In the use of `handle' (imported from Control.OldException): Deprecated: "Future versions of base will not support the old exceptions style. Please switch to extensible exceptions." Ok, modules loaded: Glob, GlobRegex. *Glob> namesMatching "*.hs" Loading package array-0.4.0.0 ... linking ... done. Loading package bytestring-0.9.2.1 ... linking ... done. Loading package deepseq-1.3.0.0 ... linking ... done. Loading package containers-0.4.2.1 ... linking ... done. Loading package transformers-0.3.0.0 ... linking ... done. Loading package mtl-2.1.2 ... linking ... done. Loading package regex-base-0.93.2 ... linking ... done. Loading package regex-posix-0.95.2 ... linking ... done. Loading package filepath-1.3.0.0 ... linking ... done. Loading package old-locale-1.0.0.4 ... linking ... done. Loading package old-time-1.1.0.0 ... linking ... done. Loading package unix-2.5.1.1 ... linking ... done. Loading package directory-1.1.0.2 ... linking ... done. ["./Exporting.hs","./Glob.hs","./GlobRegex.hs","./InteractWith.hs","./Prettify.hs","./PrettyJSON.hs","./PutJSON.hs","./Sample.hs","./SimpleJSON.hs","./Trouble.hs"] *Glob> namesMatching "*.txt" ["./gpl-3.0.txt","./hello-in.txt","./in.txt","./input.txt","./out.txt","./out_tmp.txt","./output.txt","./quux.txt","./Scratchpad.txt","./tmp.txt"] *Glob> namesMatching "./haskell/*.hs" [] *Glob> namesMatching "../haskell/*.hs" ["../haskell/Exporting.hs","../haskell/Glob.hs","../haskell/GlobRegex.hs","../haskell/InteractWith.hs","../haskell/Prettify.hs","../haskell/PrettyJSON.hs","../haskell/PutJSON.hs","../haskell/Sample.hs","../haskell/SimpleJSON.hs","../haskell/Trouble.hs"] *Glob> namesMatching "../hask*" ["../haskell"] *Glob> :quit Leaving GHCi. $
書き換える前の入出力結果と一致するっぽい。ということでたぶん合ってるのかな〜
0 コメント:
コメントを投稿