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

[Shuichi KITAGUCHI]

北口です。

もう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 at example.com / ki at example.com