できた
こっちが昨日書き直したFind。
- Find.hs module Find where import Control.Monad import System.Directory find :: String -> (FilePath -> Bool) -> IO [FilePath] find dir f = return . filter f =<< (ls_r dir) where ls_r [] = return [] ls_r dir = do all <- getDirectoryContents dir >>= return . filter notParentAndCurrent let all' = map (add dir) all in do dirs <- filterM doesDirectoryExist all' mapM ls_r dirs >>= return . (++ all') . concat notParentAndCurrent = \x -> and $ map (/= x) ["..", "."] add = (++) . flip (++) "/"
こっちが書き直したMain。引数とってくるところはメンドーだから手抜きした。引数とってくる処理なんて飾りです。偉い人には解からんのです。
- HVMain.hs module Main where import Text.Regex import System import System.IO import Control.Monad import Find (find) main = do (libDir:func:_) <- getArgs ret <- find libDir isHs >>= (mapM . view) func >>= return . filter (/= []) mapM_ putStrLn ret where isHs = \x -> reverse (take 3 (reverse x)) == ".hs" view :: String -> FilePath -> IO String view func path = do str <- search (myRegex func) =<< readFile path if str == "" then return "" else return $ ("--" ++ path ++ "\n") ++ str where myRegex func = mkRegexWithOpts ("^" ++ func ++ " (.+\n)+(^$){1}?") True True search re c = do case matchRegexAll re c of Just (_,x,y,_) -> return . (++) x =<< search re y _ -> return ""
なんだかrunghcで動かないので、真面目にコンパイルする。
$ ghc -o HVMain Find.hs HVMain.hs
できたー。正規表現をいじったから"hPutStLn"なんかもちゃんと出せるようになった。
$ ./HVMain /usr/lib/hugs/libraries foldr --/usr/lib/hugs/libraries/Hugs/Prelude.hs foldr :: (a -> b -> b) -> b -> [a] -> b foldr f z [] = z foldr f z (x:xs) = f x (foldr f z xs)
runghcで起動するとGC(ガベージコレクタ)がウンタラ言われる。GHCの構造とかもちゃんと勉強していきたいなぁ、と思う。