{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RecordWildCards #-}

module Main
  ( main
  ) where

import Data.Version (showVersion)
import Paths_git_auto_acp (version)

import Control.Concurrent
import Control.Monad
import Data.Foldable
import Data.Maybe
import qualified Data.Set as S
import Options.Applicative
import System.Clock
import System.Environment
import System.FilePath
import System.Exit
import System.FSNotify
import System.FSNotify.Devel
import System.IO
import System.Process

data Watch = Watch
  { watchPath :: FilePath
  , watchWithRemoval :: Bool
  } deriving (Show, Eq, Ord)

data Opts = Opts
  { optAddCommitDelay :: Float
  , optPushDelay :: Maybe Float
  , optWatches :: [Watch]
  , optMsg :: String
  } deriving (Show)

opts :: Parser Opts
opts = do
  optAddCommitDelay <-
    option auto
      $ 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"
      , fmap Just . option auto
          $ 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"
          , fmap (`Watch` False) . strOption
              $ short 'A'
                  <> long "add-all"
                  <> metavar "PATH"
                  <> help "like `--add' but auto-adds file removals"
          ]
  optMsg <-
    strOption
      $ short 'm'
          <> long "message"
          <> metavar "MSG"
          <> help "commit message for auto-commits"
          <> value "update to filesystem state"
          <> showDefault
  pure Opts {..}

delaySec :: Float -> IO ()
delaySec = threadDelay . round . (1000000 *)

intervalPassed :: (Ord a, Num a) => a -> TimeSpec -> TimeSpec -> Bool
intervalPassed i a b =
  1000000000 * i <= fromIntegral (toNanoSecs $ diffTimeSpec a b)

runCmd :: String -> [String] -> IO ()
runCmd prog args = do
  st <- rawSystem prog args
  unless (st == ExitSuccess) . hPutStrLn stderr
    $ prog ++ " failed with args " ++ show args

data Event
  = AddBounce
  | PushBounce
  | Change Watch
  | Finished
  deriving (Show, Eq, Ord)

main :: IO ()
main = do
  o <-
    customExecParser (prefs $ showHelpOnEmpty)
      $ info
          (opts <**> helper <**> simpleVersioner (showVersion version))
          (fullDesc
             <> header "git-auto-acp -- automatically add-commit-push files"
             <> (footer
                   "This program is free software; see LICENSE file for details."))
  git <- fromMaybe "git" <$> lookupEnv "AUTO_ACP_GIT"
  gitDir <- fromMaybe ".git" <$> lookupEnv "AUTO_ACP_GIT_DIRNAME"
  withManager $ \fsmgr -> do
    chan <- newChan
    done <- newEmptyMVar -- TODO catch sigterm
    -- start some watchers
    for_ (optWatches o) $ \w@(Watch path _) ->
      watchTree fsmgr path (allEvents $ not . elem gitDir . splitPath) . const
        $ 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
              now <- getTime Monotonic
              case ev of
                Finished -> pure ()
                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 $ \(Watch p addAll) -> do
                      if addAll
                        then runCmd git ["add", p]
                        else runCmd git ["add", "--all", p]
                    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
                    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
    -- wait for the finish, then terminate
    takeMVar done