module Git.Fmt (
Options(..), Chatty(..), Mode(..),
handle,
) where
import Control.Applicative
import Control.Concurrent
import Control.Monad.Catch (MonadMask)
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Parallel (MonadParallel)
import qualified Control.Monad.Parallel as Parallel
import Control.Monad.Reader
import Data.List.Extra (chunksOf, linesBy, lower, nub)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Yaml (prettyPrintParseException)
import Data.Yaml.Include (decodeFileEither)
import GHC.IO.Exception (IOErrorType (..))
import Git.Fmt.Config as Config
import Git.Fmt.Exit
import Git.Fmt.Process
import Prelude hiding (read)
import System.Directory.Extra hiding (withCurrentDirectory)
import System.Exit
import System.FilePath
import System.IO.Error
import System.IO.Temp
data Options = Options {
optChatty :: Chatty,
optNull :: Bool,
optNumThreads :: Maybe Int,
optMode :: Mode,
argPaths :: [FilePath]
}
deriving (Eq, Show)
data Chatty = Default | Quiet | Verbose
deriving (Eq, Show)
data Mode = Normal | DryRun
deriving (Eq, Show)
handle :: (MonadIO m, MonadLogger m, MonadMask m, MonadParallel m) => Options -> m ()
handle options = do
gitDir <- findGitDirectory
filePaths <- fmap (nub . concat) $ paths gitDir >>= mapM
(\path -> ifM (liftIO $ doesDirectoryExist path)
(liftIO $ listFilesRecursive path)
(return [path])
)
numThreads <- liftIO getNumCapabilities >>= \numCapabilities ->
return $ fromMaybe numCapabilities (optNumThreads options)
unlessM (liftIO . doesFileExist $ gitDir </> Config.defaultFileName) $ panic (gitDir </> Config.defaultFileName ++ ": not found")
config <- liftIO (decodeFileEither $ gitDir </> Config.defaultFileName) >>= \ethr -> case ethr of
Left error -> panic $ gitDir </> Config.defaultFileName ++ ": error\n" ++ prettyPrintParseException error
Right config -> return config
let supportedFilePaths = filter (supported config . T.pack . drop 1 . lower . takeExtension) filePaths
flip runReaderT config . withSystemTempDirectory "git-fmt" $ \tmpDir ->
Parallel.sequence_ . map sequence . nChunks numThreads . flip map supportedFilePaths $ \filePath -> ifM (liftIO $ doesFileExist filePath)
(fmt options filePath (tmpDir </> filePath))
($(logWarn) $ T.pack (filePath ++ ": not found"))
where
paths gitDir
| null (argPaths options) = linesBy (== '\0') <$> runProcess_ "git" ["ls-files", "-z", gitDir]
| optNull options = return $ concatMap (linesBy (== '\0')) (argPaths options)
| otherwise = return $ argPaths options
nChunks n xs = chunksOf (maximum [1, length xs `div` n]) xs
fmt :: (MonadIO m, MonadLogger m, MonadReader Config m) => Options -> FilePath -> FilePath -> m ()
fmt options filePath tmpFilePath = do
config <- ask
let program = unsafeProgramFor config (T.pack . drop 1 $ takeExtension filePath)
(exitCode, _, stderr) <- runProgram program filePath tmpFilePath
if exitCode == ExitSuccess
then diff options filePath tmpFilePath
else $(logWarn) (T.pack $ filePath ++ ": error") >>
$(logDebug) (T.pack stderr)
diff :: (MonadIO m, MonadLogger m) => Options -> FilePath -> FilePath -> m ()
diff options filePath tmpFilePath = do
(exitCode, _, stderr) <- runProcess "diff" [filePath, tmpFilePath]
case exitCode of
ExitSuccess -> $(logDebug) $ T.pack (filePath ++ ": pretty")
ExitFailure 1 -> action filePath tmpFilePath
_ -> $(logWarn) $ T.pack stderr
where
action = case optMode options of
Normal -> normal
DryRun -> dryRun
normal :: (MonadIO m, MonadLogger m) => FilePath -> FilePath -> m ()
normal filePath tmpFilePath = do
$(logInfo) $ T.pack (filePath ++ ": prettified")
liftIO $ renameFile tmpFilePath filePath `catchIOError` \e ->
if ioeGetErrorType e == UnsupportedOperation
then copyFile tmpFilePath filePath >> removeFile tmpFilePath
else ioError e
dryRun :: (MonadIO m, MonadLogger m) => FilePath -> FilePath -> m ()
dryRun filePath _ = $(logInfo) $ T.pack (filePath ++ ": ugly")
findGitDirectory :: (MonadIO m, MonadLogger m) => m String
findGitDirectory = do
(exitCode, stdout, _) <- runProcess "git" ["rev-parse", "--show-toplevel"]
if exitCode == ExitSuccess
then return $ init stdout
else panic ".git/: not found"
runProgram :: (MonadIO m, MonadLogger m) => Program -> FilePath -> FilePath -> m (ExitCode, String, String)
runProgram program filePath tmpFilePath = do
liftIO $ createDirectoryIfMissing True (takeDirectory tmpFilePath)
runCommand . T.unpack $ substitute (T.concat [command program, inputSuffix, outputSuffix]) [
(inputVariableName, quote filePath),
(outputVariableName, quote tmpFilePath)
]
where
inputSuffix
| usesInputVariable (command program) = T.empty
| otherwise = T.pack " < " `T.append` inputVariableName
outputSuffix
| usesOutputVariable (command program) = T.empty
| otherwise = T.pack " > " `T.append` outputVariableName
quote str = T.pack $ '"':concatMap escape str ++ "\""
escape '\\' = "\\\\"
escape '"' = "\\\""
escape c = [c]