debug it

1 files changed, 26 insertions, 11 deletions

diff --git a/Main.hs b/Main.hs
index 8611e59..47b3581 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,9 +1,7 @@
 {-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE RecordWildCards #-}
 
-module Main
-  ( main
-  ) where
+module Main where
 
 import Data.Version (showVersion)
 import Paths_git_auto_acp (version)
@@ -21,6 +19,7 @@ import System.FSNotify
 import System.FSNotify.Devel
 import System.FilePath
 import System.IO
+import System.Posix.Signals
 import System.Process
 
 data Watch = Watch
@@ -33,6 +32,7 @@ data Opts = Opts
   , optPushDelay :: Maybe Float
   , optWatches :: [Watch]
   , optMsg :: String
+  , optDebug :: Bool
   } deriving (Show)
 
 opts :: Parser Opts
@@ -67,7 +67,7 @@ opts = do
               $ short 'A'
                   <> long "add-all"
                   <> metavar "PATH"
-                  <> help "like `--add' but auto-adds file removals"
+                  <> help "like `--add' but also auto-adds file removals"
           ]
   optMsg <-
     strOption
@@ -77,6 +77,9 @@ opts = do
           <> help "commit message for auto-commits"
           <> value "update to filesystem state"
           <> showDefault
+  optDebug <-
+    flag' True (long "debug" <> help "be super verbose about what's happening")
+      <|> pure False
   pure Opts {..}
 
 delaySec :: Float -> IO ()
@@ -109,23 +112,32 @@ main = do
              <> header "git-auto-acp -- automatically add-commit-push files"
              <> (footer
                    "This program is free software; see LICENSE file for details."))
+  let dbg
+        | optDebug o = hPutStrLn stderr . ("*** " ++)
+        | otherwise = const $ pure ()
   git <- fromMaybe "git" <$> lookupEnv "AUTO_ACP_GIT"
+  dbg $ "using git: " ++ git
   gitDir <- fromMaybe ".git" <$> lookupEnv "AUTO_ACP_GIT_DIRNAME"
+  dbg $ "filtering out git directory: " ++ gitDir
   withManager $ \fsmgr -> do
     chan <- newChan
-    done <- newEmptyMVar -- TODO catch sigterm
+    done <- newEmptyMVar
+    installHandler sigINT (Catch $ writeChan chan Finished) Nothing
     -- start some watchers
-    for_ (optWatches o) $ \w@(Watch path _) ->
-      watchTree fsmgr path (allEvents $ not . elem gitDir . splitPath) . const
-        $ writeChan chan (Change w)
+    for_ (optWatches o) $ \w@(Watch path _) -> do
+      dbg $ "starting a watch: " ++ show w
+      watchTree fsmgr path (allEvents $ not . elem gitDir . splitDirectories) $ \ev -> do
+        dbg $ "fsnotify says: " ++ show ev
+        writeChan chan (Change w)
     -- start the event crunching thread
     void . forkIO
       $ let loop :: S.Set Watch -> TimeSpec -> Int -> TimeSpec -> Int -> IO ()
             loop ws lastAdd addsPending lastPush pushesPending = do
               ev <- readChan chan
+              dbg $ "processing event: " ++ show ev
               now <- getTime Monotonic
               case ev of
-                Finished -> pure ()
+                Finished -> putMVar done ()
                 Change w -> do
                   void . forkIO
                     $ delaySec (optAddCommitDelay o) >> writeChan chan AddBounce
@@ -145,10 +157,12 @@ main = do
                   | not (S.null ws)
                   , addsPending == 1
                       || intervalPassed (optAddCommitDelay o) now lastAdd -> do
-                    for_ ws $ \(Watch p addAll) -> do
+                    for_ ws $ \w@(Watch p addAll) -> do
+                      dbg $ "will add: " ++ show w
                       if addAll
                         then runCmd git ["add", p]
-                        else runCmd git ["add", "--all", p]
+                        else runCmd git ["add", "--ignore-removal", p]
+                    dbg "commit!"
                     runCmd git ["commit", "--message", optMsg o]
                     loop S.empty now (pred addsPending) lastPush pushesPending
                   | otherwise ->
@@ -161,6 +175,7 @@ main = do
                 PushBounce
                   | Just pd <- optPushDelay o
                   , pushesPending == 1 || intervalPassed pd now lastPush -> do
+                    dbg $ "push!"
                     runCmd git ["push"]
                     loop ws lastAdd addsPending now (pred pushesPending)
                   | otherwise ->