2011年9月11日

[mew-dist 29415] Re: Mew 6.4 release candidate 1

北口です。

もう1点、ずっと気になっていたHaskell版のcmewで k i が効か
ない問題を直してみました(つもり)。

相変わらず文法わからずにやってるので、書き方が正しいか
よくわかってません m(__)m

diff --git a/bin/hs/Index.hs b/bin/hs/Index.hs
old mode 100644
new mode 100755
index 4768e56..b0fd12a
--- a/bin/hs/Index.hs
+++ b/bin/hs/Index.hs
@@ -68,17 +68,21 @@ toBeAdded msg = putStrLn $ " " ++ path msg ++ " (to be added)"

----------------------------------------------------------------

-makeIndex :: Bool -> Bool -> FilePath -> FilePath -> String -> IO (Int, Int)
-makeIndex dryRun fullUpdate db dir re =
+makeIndex :: Bool -> Bool -> FilePath -> FilePath -> String -> String -> IO (Int, Int)
+makeIndex dryRun fullUpdate db dir re target =
withNewDB db (not fullUpdate) $ \conn -> do
createDB conn
stime <- utctimeToInteger <$> getCurrentTime
ctl <- makeControl conn
- walkDirectory dir ctl
+ walkDirectory getTargetDir ctl
indexDB conn
unless dryRun $ setDBModtime conn stime
results ctl
where
+ getTargetDir = do
+ if target == ""
+ then dir
+ else dir ++ "/" ++ target
makeControl conn = do
let ctl0 = defaultCtl
ctl1 <- makeControl1 ctl0 dir re
diff --git a/bin/hs/Param.hs b/bin/hs/Param.hs
old mode 100644
new mode 100755
index 6698f40..96e9117
--- a/bin/hs/Param.hs
+++ b/bin/hs/Param.hs
@@ -14,3 +14,6 @@ defaultMessageRegex = "^[0-9]+(\\.mew)?$"

defaultDirModFile :: String
defaultDirModFile = ".mew-mtime"
+
+defaultTarget :: String
+defaultTarget = ""
diff --git a/bin/hs/cmew.hs b/bin/hs/cmew.hs
old mode 100644
new mode 100755
index 835b81c..0370546
--- a/bin/hs/cmew.hs
+++ b/bin/hs/cmew.hs
@@ -29,11 +29,12 @@ parseOpts opts
dryRun = "-n" `elem` opts
fullUpdate = "-f" `elem` opts

-parseArgs :: [String] -> Maybe (FilePath,FilePath,String)
-parseArgs [] = Just (defaultDB,defaultMailDir,defaultIgnoreRegex)
-parseArgs [db] = Just (db,defaultMailDir,defaultIgnoreRegex)
-parseArgs [db,dir] = Just (db,dir,defaultIgnoreRegex)
-parseArgs [db,dir,re] = Just (db,dir,re)
+parseArgs :: [String] -> Maybe (FilePath,FilePath,String,String)
+parseArgs [] = Just (defaultDB,defaultMailDir,defaultIgnoreRegex,defaultTarget)
+parseArgs [db] = Just (db,defaultMailDir,defaultIgnoreRegex,defaultTarget)
+parseArgs [db,dir] = Just (db,dir,defaultIgnoreRegex,defaultTarget)
+parseArgs [db,dir,re] = Just (db,dir,re,defaultTarget)
+parseArgs [db,dir,re,target] = Just (db,dir,re,target)
parseArgs _ = Nothing

----------------------------------------------------------------
@@ -45,9 +46,9 @@ main = do
mopt = parseOpts opts
exec mopt mtri
where
- exec (Just (dryRun,fullUpdate)) (Just (db,dir,re)) = do
+ exec (Just (dryRun,fullUpdate)) (Just (db,dir,re,target)) = do
db' <- normalizePath db
dir' <- normalizePath dir
- makeIndex dryRun fullUpdate db' dir' re >>= printResults
+ makeIndex dryRun fullUpdate db' dir' re target >>= printResults
exec _ _ = help helpMessage
printResults (reg,del) = putStrLn $ "Registered: " ++ show reg ++ ", deleted: " ++ show del


--
Shuichi KITAGUCHI // kit@xxxxx / ki@xxxxx


投稿者 xml-rpc : 2011年9月11日 19:54
役に立ちました?:
過去のフィードバック 平均:(0) 総合:(0) 投票回数:(0)
本記事へのTrackback: http://hoop.euqset.org/blog/mt-tb2006.cgi/106763
トラックバック
コメント
コメントする




画像の中に見える文字を入力してください。