aboutsummaryrefslogtreecommitdiff
path: root/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Main.hs')
-rw-r--r--Main.hs129
1 files changed, 77 insertions, 52 deletions
diff --git a/Main.hs b/Main.hs
index 47b3581..7532878 100644
--- a/Main.hs
+++ b/Main.hs
@@ -75,7 +75,7 @@ opts = do
<> long "message"
<> metavar "MSG"
<> help "commit message for auto-commits"
- <> value "update to filesystem state"
+ <> value "[auto-acs] update #%n"
<> showDefault
optDebug <-
flag' True (long "debug" <> help "be super verbose about what's happening")
@@ -102,6 +102,24 @@ data Event
| Finished
deriving (Show, Eq, Ord)
+data St = St
+ { stWatch :: S.Set Watch
+ , stLastAdd :: TimeSpec
+ , stAddsPending :: Int
+ , stLastPush :: TimeSpec
+ , stPushesPending :: Int
+ , stCommitSeries :: Int
+ } deriving (Show)
+
+emptyState :: St
+emptyState = St S.empty 0 0 0 0 1
+
+mkMsg :: Int -> String -> String
+mkMsg idx ('%':'n':cs) = show idx ++ mkMsg idx cs
+mkMsg idx ('%':'%':cs) = '%' : mkMsg idx cs
+mkMsg idx (c:cs) = c : mkMsg idx cs
+mkMsg _ [] = []
+
main :: IO ()
main = do
o <-
@@ -130,56 +148,63 @@ main = 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 -> putMVar done ()
- Change w -> do
- void . forkIO
- $ delaySec (optAddCommitDelay o) >> writeChan chan AddBounce
- let ws' = S.insert w ws
- case optPushDelay o of
- Nothing ->
- loop ws' lastAdd (succ addsPending) lastPush pushesPending
- Just pd -> do
- void . forkIO $ delaySec pd >> writeChan chan PushBounce
- loop
- ws'
- lastAdd
- (succ addsPending)
- lastPush
- (succ pushesPending)
- AddBounce
- | not (S.null ws)
- , addsPending == 1
- || intervalPassed (optAddCommitDelay o) now lastAdd -> do
- for_ ws $ \w@(Watch p addAll) -> do
- dbg $ "will add: " ++ show w
- if addAll
- then runCmd git ["add", 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 ->
- loop
- S.empty
- lastAdd
- (pred addsPending)
- lastPush
- pushesPending
- 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 ->
- loop ws lastAdd addsPending lastPush (pred pushesPending)
- in loop S.empty 0 0 0 0
+ let loop st@St {..} = do
+ ev <- readChan chan
+ dbg $ "processing event: " ++ show ev
+ now <- getTime Monotonic
+ case ev of
+ Finished -> putMVar done ()
+ Change w -> do
+ void . forkIO
+ $ delaySec (optAddCommitDelay o) >> writeChan chan AddBounce
+ let ws' = S.insert w stWatch
+ case optPushDelay o of
+ Nothing ->
+ loop st {stWatch = ws', stAddsPending = succ stAddsPending}
+ Just pd -> do
+ void . forkIO $ delaySec pd >> writeChan chan PushBounce
+ loop
+ st
+ { stWatch = ws'
+ , stAddsPending = succ stAddsPending
+ , stPushesPending = succ stPushesPending
+ }
+ AddBounce
+ | not (S.null stWatch)
+ , stAddsPending == 1
+ || intervalPassed (optAddCommitDelay o) now stLastAdd -> do
+ for_ stWatch $ \w@(Watch p addAll) -> do
+ dbg $ "will add: " ++ show w
+ if addAll
+ then runCmd git ["add", p]
+ else runCmd git ["add", "--ignore-removal", p]
+ dbg "commit!"
+ runCmd
+ git
+ ["commit", "--message", mkMsg stCommitSeries $ optMsg o]
+ loop
+ st
+ { stWatch = S.empty
+ , stLastAdd = now
+ , stAddsPending = pred stAddsPending
+ , stCommitSeries = succ stCommitSeries
+ }
+ | otherwise ->
+ loop st {stWatch = S.empty, stAddsPending = pred stAddsPending}
+ PushBounce
+ | Just pd <- optPushDelay o
+ , stPushesPending == 1 || intervalPassed pd now stLastPush -> do
+ dbg $ "push!"
+ runCmd git ["push"]
+ loop
+ st
+ { stWatch = S.empty
+ , stLastPush = now
+ , stPushesPending = pred stPushesPending
+ }
+ | otherwise ->
+ loop
+ st {stWatch = S.empty, stPushesPending = pred stPushesPending}
+ void . forkIO $ loop emptyState
-- wait for the finish, then terminate
takeMVar done