-- |
-- Module      :  Cmd
-- Copyright   :  (C) 2014  Jens Petersen
--
-- Maintainer  :  Jens Petersen <petersen@fedoraproject.org>
-- Stability   :  alpha
-- Portability :  *nix
--
-- Explanation: system/shell command utils

-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.

module Utils (checkPkgsGit,
              cmd,
              cmd_,
              cmdBool,
              cmdFragile,
              cmdFragile_,
              cmdlog,
              cmdMaybe,
              cmdN,
              cmdSilent,
              cmdStdErr,
              error_,
              git,
              git_,
              gitBranch,
              grep,
              logMsg,
              maybeRemovePrefix,
              removePrefix,
              removeSuffix,
              singleLine,
              sudo,
              withCurrentDirectory,
              (+-+) ) where

#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2))
#else
import Control.Applicative ((<$>))
#endif
import Control.Concurrent (threadDelay)
import Control.Monad (unless, void, when)
import Data.List (isPrefixOf, stripPrefix)
import Data.Maybe (fromMaybe)
import System.Exit (ExitCode (..))
import System.IO (hPutStrLn, stderr)
import System.Process (readProcess, readProcessWithExitCode, rawSystem)

#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))
import System.Directory (withCurrentDirectory)
#else
import Control.Exception (bracket)
import System.Directory (getCurrentDirectory, setCurrentDirectory)
#endif

infixr 4 +-+
(+-+) :: String -> String -> String
"" +-+ s = s
s +-+ "" = s
s +-+ t = s ++ " " ++ t

cmdStdIn :: String -> [String] -> String -> IO String
cmdStdIn c as inp = removeTrailingNewline <$> readProcess c as inp

cmd :: String -> [String] -> IO String
cmd c as = cmdStdIn c as ""

removeTrailingNewline :: String -> String
removeTrailingNewline "" = ""
removeTrailingNewline str =
  if last str == '\n'
  then init str
  else str

singleLine :: String -> String
singleLine "" = ""
singleLine s = (head . lines) s

cmdMaybe :: String -> [String] -> IO (Maybe String)
cmdMaybe c as = do
  (ret, out, _err) <- readProcessWithExitCode c as ""
  case ret of
    ExitSuccess -> return $ Just $ removeTrailingNewline out
    ExitFailure _ -> return Nothing

cmdStdErr :: String -> [String] -> IO (String, String)
cmdStdErr c as = do
  (_ret, out, err) <- readProcessWithExitCode c as ""
  return (removeTrailingNewline out, removeTrailingNewline err)

-- cmdBoolStd :: String -> [String] -> IO (Bool, String)
-- cmdBoolStd c as = do
--   (ret, out, err) <- readProcessWithExitCode c as ""
--   case ret of
--     ExitSuccess -> return (True, out)
--     ExitFailure n -> hPutStrLn stderr ("\"" ++ c +-+ unwords as ++ "\"" +-+ "failed with status" +-+ show n ++ "\n" ++ err) >> return (False, out)

cmdStdIn_ :: String -> [String] -> String -> IO ()
cmdStdIn_ c as inp = void $ cmdStdIn c as inp

cmd_ :: String -> [String] -> IO ()
cmd_ c as = do
  ret <- rawSystem c as
  case ret of
    ExitSuccess -> return ()
    ExitFailure n -> error $ "\"" ++ c +-+ unwords as ++ "\" failed with exit code" +-+ show n

cmdFragile :: String -> [String] -> IO String
cmdFragile c as = do
  (ret, out, err) <- readProcessWithExitCode c as ""
  case ret of
    ExitSuccess -> return out
    ExitFailure n -> do
      unless (null out) $ putStrLn out
      when (null (out ++ err)) $
        hPutStrLn stderr $ "\"" ++ c +-+ unwords as ++ "\"" +-+ "failed with status" +-+ show n
      unless (null err) $ hPutStrLn stderr err
      threadDelay 2000000
      cmdFragile c as

cmdFragile_ :: String -> [String] -> IO ()
cmdFragile_ c as = do
  ret <- rawSystem c as
  case ret of
    ExitSuccess -> return ()
    ExitFailure _ -> do
      hPutStrLn stderr $ "retrying \"" ++ c +-+ unwords as ++ "\""
      threadDelay 2000000
      cmdFragile_ c as

-- dry-run
cmdN :: String -> [String] -> IO ()
cmdN c as = putStrLn $ c +-+ unwords as

--cmdAssert :: String -> String -> [String] -> IO ()
--cmdAssert msg c as = do
--  ret <- rawSystem c as
--  case ret of
--    ExitSuccess -> return ()
--    ExitFailure _ -> error msg

cmdlogStdIn :: String -> [String] -> String -> IO ()
cmdlogStdIn c as inp = do
  date <- cmd "date" ["+%T"]
  putStrLn $ date +-+ c +-+ unwords as
  cmdStdIn_ c as inp

cmdlog :: String -> [String] -> IO ()
cmdlog c as = cmdlogStdIn c as ""

logMsg :: String -> IO ()
logMsg msg = do
  date <- cmd "date" ["+%T"]
  putStrLn $ date +-+ msg

cmdBool :: String -> [String] -> IO Bool
cmdBool c as = do
  ret <- rawSystem c as
  case ret of
    ExitSuccess -> return True
    ExitFailure _ -> return False

-- hide stdout
cmdSilent :: String -> [String] -> IO ()
cmdSilent c as = do
  (ret, _, err) <- readProcessWithExitCode c as ""
  case ret of
    ExitSuccess -> return ()
    ExitFailure n -> error $ "\"" ++ c +-+ unwords as ++ "\"" +-+ "failed with status" +-+ show n ++ "\n" ++ err

sudo :: String -> [String] -> IO ()
sudo c as = cmdlog "sudo" (c:as)

--shell :: String -> IO String
--shell c = cmd "sh" ["-c", c]

removePrefix :: String -> String -> String
removePrefix prefix orig =
  fromMaybe (error prefix +-+ "is not prefix of" +-+ orig) $ stripPrefix prefix orig

maybeRemovePrefix :: String -> String -> String
maybeRemovePrefix prefix orig =
  fromMaybe orig $ stripPrefix prefix orig

removeSuffix :: String -> String -> String
removeSuffix suffix orig =
  fromMaybe orig $ stripSuffix suffix orig
  where
    stripSuffix sf str = reverse <$> stripPrefix (reverse sf) (reverse str)

error_ :: String -> a
#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,9,0))
error_ = errorWithoutStackTrace
#else
error_ = error
#endif

#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))
#else
withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory dir action =
  bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do
    setCurrentDirectory dir
    action
#endif

checkPkgsGit :: IO Bool
checkPkgsGit =
  grep "\\(pkgs\\|src\\)." ".git/config"

git :: String -> [String] -> IO String
git c as =
  cmd "git" ("--no-pager":c:as)

git_ :: String -> [String] -> IO ()
git_ c as =
  cmd_ "git" ("--no-pager":c:as)

gitBranch :: IO String
gitBranch =
  removePrefix "* " . head . filter (isPrefixOf "* ") . lines <$> cmd "git" ["branch"]

grep :: String -> FilePath -> IO Bool
grep pat file =
  cmdBool "grep" ["-q", pat, file]