aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMirek Kratochvil <exa.exa@gmail.com>2026-09-10 20:52:28 +0200
committerMirek Kratochvil <exa.exa@gmail.com>2026-09-10 20:52:55 +0200
commit3a35c8bcc3d22a3fd3d1ad49f8da72b9da2d562f (patch)
tree90b9d76aad70c7355358945b95498623251cacbc
parent1804e7f25b727aec985053d39a18d22c35adf66c (diff)
downloadgit-auto-acp-3a35c8bcc3d22a3fd3d1ad49f8da72b9da2d562f.tar.gz
git-auto-acp-3a35c8bcc3d22a3fd3d1ad49f8da72b9da2d562f.tar.bz2
debug it
-rw-r--r--Main.hs37
-rw-r--r--git-auto-acp.cabal1
2 files changed, 27 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 ->
diff --git a/git-auto-acp.cabal b/git-auto-acp.cabal
index 88aeced..ba24d89 100644
--- a/git-auto-acp.cabal
+++ b/git-auto-acp.cabal
@@ -33,6 +33,7 @@ executable git-auto-acp
, fsnotify
, optparse-applicative
, process
+ , unix
hs-source-dirs: .
default-language: Haskell2010