start cleaning up

1 files changed, 96 insertions, 88 deletions

diff --git a/Main.hs b/Main.hs
index b9afcc4..d0479b0 100644
--- a/Main.hs
+++ b/Main.hs
@@ -8,7 +8,9 @@ import Paths_git_auto_acp (version)
 
 import Control.Applicative ((<|>), some)
 import Control.Concurrent
-  ( forkIO
+  ( Chan
+  , MVar
+  , forkIO
   , newChan
   , newEmptyMVar
   , putMVar
@@ -74,48 +76,55 @@ data Opts = Opts
 
 opts :: Parser Opts
 opts = do
+  let infix 8 ~~
+      (~~) f = f . mconcat
   optAddCommitDelay <-
     option auto
-      $ short 'd'
-          <> long "commit-delay"
-          <> help "debuounce delay for adding and commiting new changes"
-          <> value 5
-          <> showDefault
+      ~~ [ short 'd'
+         , long "commit-delay"
+         , help "debuounce delay for adding and commiting new changes"
+         , value 5
+         , showDefault
+         ]
   optPushDelay <-
     asum
       [ flag' Nothing
-          $ short 'L' <> long "local" <> help "only work locally, do not push"
+          ~~ [short 'L', long "local", help "only work locally, do not push"]
       , fmap Just . option auto
-          $ short 'D'
-              <> long "push-delay"
-              <> help "push changes upstream with this debuounce delay"
-              <> value 60
-              <> showDefault
+          ~~ [ short 'D'
+             , long "push-delay"
+             , help "push changes upstream with this debuounce delay"
+             , value 60
+             , showDefault
+             ]
       ]
   optWatches <-
     some
       $ asum
           [ fmap (`Watch` False) . strOption
-              $ short 'a'
-                  <> long "add"
-                  <> metavar "PATH"
-                  <> help "paths to auto-add"
+              ~~ [ short 'a'
+                 , long "add"
+                 , metavar "PATH"
+                 , help "paths to auto-add"
+                 ]
           , fmap (`Watch` True) . strOption
-              $ short 'A'
-                  <> long "add-all"
-                  <> metavar "PATH"
-                  <> help "like `--add' but also auto-adds file removals"
+              ~~ [ short 'A'
+                 , long "add-all"
+                 , metavar "PATH"
+                 , help "like `--add' but also auto-adds file removals"
+                 ]
           ]
   optMsg <-
     strOption
-      $ short 'm'
-          <> long "message"
-          <> metavar "MSG"
-          <> help "commit message for auto-commits"
-          <> value "[auto-acs] update #%n"
-          <> showDefault
+      ~~ [ short 'm'
+         , long "message"
+         , metavar "MSG"
+         , help "commit message for auto-commits"
+         , value "[auto-acs] update #%n"
+         , showDefault
+         ]
   optDebug <-
-    flag' True (long "debug" <> help "be super verbose about what's happening")
+    flag' True ~~ [long "debug", help "be super verbose about what's happening"]
       <|> pure False
   pure Opts {..}
 
@@ -185,66 +194,65 @@ main = do
         dbg $ "fsnotify says: " ++ show ev
         writeChan chan (Change w)
     -- start the event crunching thread
-    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 {- protection against triggering too early -}
-                  || 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 = 0
-                    , stCommitSeries = succ stCommitSeries
-                    }
-              | otherwise ->
-                loop
-                  st
-                    { stWatch = S.empty
-                    , stAddsPending = 0 `max` 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 = 0}
-              | otherwise ->
-                loop
-                  st
-                    { stWatch = S.empty
-                    , stPushesPending = 0 `max` pred stPushesPending
-                    }
-    void . forkIO $ loop emptyState
+    void . forkIO $ mainLoop git dbg chan done o emptyState
     -- wait for the finish, then terminate
     takeMVar done
+
+mainLoop ::
+     String -> ([Char] -> IO ()) -> Chan Event -> MVar () -> Opts -> St -> IO ()
+mainLoop git dbg chan done o = loop
+  where
+    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 {- protection against triggering too early -}
+              || 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 = 0
+                , stCommitSeries = succ stCommitSeries
+                }
+          | otherwise ->
+            loop
+              st {stWatch = S.empty, stAddsPending = 0 `max` 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 = 0}
+          | otherwise ->
+            loop
+              st
+                { stWatch = S.empty
+                , stPushesPending = 0 `max` pred stPushesPending
+                }