app/Rehi/GitCommands.hs

   1 {-# LANGUAGE LambdaCase #-}
   2 {-# LANGUAGE PatternGuards #-}
   3 {-# LANGUAGE OverloadedLists #-}
   4 {-# LANGUAGE OverloadedStrings #-}
   5 module Rehi.GitCommands where
   6
   7 import Data.Maybe (maybe)
   8 import Data.Monoid ((<>))
   9
  10 import qualified Data.ByteString as B
  11
  12 import Rehi.GitTypes
  13 import Rehi.Utils (equalWith, index_only, mapFileLinesM, modifySnd,
  14                    trim, writeFile, appendToFile, whenM, unlessM, ifM, popen_lines)
  15 import Rehi.Utils.ArgList (ArgList(ArgList), getArgList)
  16 import Rehi.Utils.IO (readCommand,callProcess)
  17
  18 fixup :: B.ByteString -> IO ()
  19 fixup ref = do
  20   git ("cherry-pick --allow-empty --allow-empty-message --no-commit" <> [ref])
  21   git "commit --amend --reset-author --no-edit"
  22
  23 reset :: B.ByteString -> IO ()
  24 reset ref = git ("reset --hard" <> [ref])
  25
  26 checkout_detached :: B.ByteString -> IO ()
  27 checkout_detached ref =  git ("checkout --quiet --detach" <> [ref])
  28
  29 checkout_here :: B.ByteString -> IO ()
  30 checkout_here branch = git ("checkout -B" <> [branch])
  31
  32 checkout_force :: B.ByteString -> IO ()
  33 checkout_force branch = git ("checkout -f" <> [branch])
  34
  35 verify_clean :: IO ()
  36 verify_clean = do
  37   readCommand "git rev-parse --verify HEAD"
  38   git "update-index --ignore-submodules --refresh"
  39   git "diff-files --quiet --ignore-submodules"
  40
  41 commit :: Maybe B.ByteString -> IO ()
  42 commit refMb = git ("commit" <> maybe [] (\r -> ["-c", r]) refMb)
  43
  44 commit_amend :: IO ()
  45 commit_amend = git "commit --amend"
  46
  47 commit_amend_msgFile :: B.ByteString -> IO ()
  48 commit_amend_msgFile path = git ("commit --amend -F" <> [path])
  49
  50 commit_refMsgOnly :: B.ByteString -> IO ()
  51 commit_refMsgOnly ref = git ("commit -C" <> [ref] <> "--reset-author")
  52
  53 cherrypick :: B.ByteString -> IO ()
  54 cherrypick ref = git ("cherry-pick --allow-empty --allow-empty-message --ff" <> [ref])
  55
  56 merge :: Bool -> Bool -> Bool -> [B.ByteString] -> IO ()
  57 merge doCommit ours noff parents = git command
  58   where
  59     command :: ArgList
  60     command = "merge"
  61                     <> (if doCommit then ["--no-edit"] else ["--no-commit"])
  62                     <> (if ours then ["--strategy=ours"] else [])
  63                     <> (if noff then ["--no-ff"] else [])
  64                     <> ArgList parents
  65
  66 git_resolve_hashes :: [B.ByteString] -> IO [Hash]
  67 git_resolve_hashes refs = do
  68   hashes <- fmap (map (Hash . trim)) $ popen_lines "git" ("rev-parse" <> ArgList (map (<> "^{commit}") refs)) '\n'
  69   if length hashes == length refs
  70     then pure hashes
  71     else error "Hash number does not match"
  72
  73 edit_config_file :: B.ByteString -> IO ()
  74 edit_config_file path = git ("config --edit --file" <> [path])
  75
  76 git :: ArgList -> IO ()
  77 git al = callProcess "git" (getArgList al)