kowainik/hit-on
1
1
Fork 0
mirror of https://github.com/kowainik/hit-on.git synced 2024-11-03 23:06:10 +03:00
Code Issues Projects Releases Wiki Activity

[#129] Split Git into smaller modules (#132)

Browse Source 
* Extract `nameOrMaster` into common

* Extract `uncommit` into own module

* Extract `hop` into own module

* Extract `fresh` into own module

* Extract `log` into own module

* Extract all internal helpers into `Common` module

* Extract `stash` into own module

* Extract `unstash` into own module

* Extract `sync` into own module

* Extract `push` into own module

* Extract `diff` into own module

* Extract `runStatus` into the Status module

* Extract `current` into own module

* Extract `fix` into own module

* Extract `amend` into own module

* Extract `resolve` into own module

* Extract `clone` and `clear` into own module

* Extract `commit` into own module

* Extract `new` into own module

* Prettify imports

* Recover behaviour with shellmet

* Remove trailing whitespaces

* Update src/Hit/Git/Clone.hs

Co-Authored-By: Veronika Romashkina <vrom911@gmail.com>

* Apply suggestions from code review

Co-Authored-By: Veronika Romashkina <vrom911@gmail.com>

* Put qualified imports after all other imports

remove question comment,
add two empty lines before code starts

Co-authored-by: Veronika Romashkina <vrom911@gmail.com>
This commit is contained in:
Max Strübing 2019-12-20 15:53:47 +01:00 committed by Veronika Romashkina
parent db32a9d41a
commit 4c487b9b3f
21 changed files with 559 additions and 337 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
hit-on.cabal
View File

@ -61,7 +61,25 @@ library
Hit.Core
Hit.Formatting
Hit.Git
Hit.Git.Amend
Hit.Git.Clear
Hit.Git.Clone
Hit.Git.Commit
Hit.Git.Common
Hit.Git.Current
Hit.Git.Diff
Hit.Git.Fix
Hit.Git.Fresh
Hit.Git.Hop
Hit.Git.Log
Hit.Git.New
Hit.Git.Push
Hit.Git.Resolve
Hit.Git.Stash
Hit.Git.Status
Hit.Git.Sync
Hit.Git.Uncommit
Hit.Git.Unstash
Hit.Issue
autogen-modules: Paths_hit_on

353
src/Hit/Git.hs
View File

@ -1,6 +1,4 @@
{-# LANGUAGE ViewPatterns #-}
-- | Logic for CLI commands to make GitHub workflows easier.
-- | Reexports of the single commands
module Hit.Git
( runHop
@ -25,333 +23,22 @@ module Hit.Git
, getUsername
) where
import Control.Exception (bracket)
import Data.Char (isAlphaNum, isDigit, isSpace)
import GitHub (Issue (issueNumber), IssueNumber (..), unIssueNumber)
import Shellmet (($|))
import System.Directory (findExecutable)
import System.Process (callCommand)
import Hit.ColorTerminal (Answer (..), arrow, errorMessage, greenCode, infoMessage, prompt,
resetCode, successMessage, yesOrNoText)
import Hit.Core (CommitOptions (..), PushBool (..))
import Hit.Git.Status (showPrettyDiff)
import Hit.Issue (createIssue, getIssueTitle, mkIssueId)
import qualified Data.Text as T
-- | @hit hop@ command.
runHop :: Maybe Text -> IO ()
runHop (nameOrMaster -> branch) = do
"git" ["checkout", branch]
"git" ["pull", "--rebase", "--prune"]
-- | @hit fresh@ command.
runFresh :: Maybe Text -> IO ()
runFresh (nameOrMaster -> branch) = do
"git" ["fetch", "origin", branch]
"git" ["rebase", "origin/" <> branch]
-- QUESTION: should we somehow move this into separate module or split this module
-- smaller parts?
{- | This data type represents all cases on how to create short branch
name description. During 'hit new' command there can be several cases:
1. 'FromNewIssue': when new issue is created, we know its title and number.
2. 'FromIssueNumber': if issue is not created, we need to fetch its title by id.
3. 'FromText': if not issue number is provided, we just create raw text.
-}
data BranchDescription
= FromNewIssue Int Text
| FromIssueNumber Int
| FromText Text
-- | Create 'BranchTitle' from possible issue and issue number or text.
mkBranchDescription :: Maybe IssueNumber -> Text -> BranchDescription
mkBranchDescription (Just issueNum) title = FromNewIssue (unIssueNumber issueNum) title
mkBranchDescription Nothing issueOrName = case readMaybe @Int $ toString issueOrName of
Just issueNum -> FromIssueNumber issueNum
Nothing -> FromText issueOrName
{- | Display 'BranchDescription' in format:
@
123-short-issue-title
@
-}
displayBranchDescription :: BranchDescription -> IO Text
displayBranchDescription = \case
FromText text -> pure $ mkShortDesc text
FromNewIssue issueNum issueTitle -> pure $ nameWithNumber issueNum issueTitle
FromIssueNumber issueNum -> do
issueTitle <- getIssueTitle $ mkIssueId issueNum
pure $ nameWithNumber issueNum issueTitle
where
nameWithNumber :: Int -> Text -> Text
nameWithNumber issueNum issueTitle =
show issueNum <> "-" <> mkShortDesc issueTitle
mkShortDesc :: Text -> Text
mkShortDesc =
T.intercalate "-"
. take 5
. words
. T.filter (\c -> isAlphaNum c
|| isDigit c
|| isSpace c
|| c `elem` ("_-./" :: String)
)
-- | @hit new@ command.
runNew :: Bool -> Text -> IO ()
runNew isIssue issueOrName = do
login <- getUsername
maybeIssue <- if isIssue then tryCreateNewIssue login else pure Nothing
let branchDescription = mkBranchDescription maybeIssue issueOrName
title <- displayBranchDescription branchDescription
let branchName = login <> "/" <> title
"git" ["checkout", "-b", branchName]
where
tryCreateNewIssue :: Text -> IO (Maybe IssueNumber)
tryCreateNewIssue login = do
infoMessage $ "Creating issue with title: '" <> issueOrName <> "'"
createIssue issueOrName login >>= \case
Left err -> do
errorMessage "Error creating issue under 'hit new' command!"
putTextLn $ show err
pure Nothing
Right issue -> do
let issueNum = issueNumber issue
successMessage $ "Successfully created issue number #"
<> show (unIssueNumber issueNum)
pure $ Just issueNum
-- | @hit commit@ command.
runCommit :: CommitOptions -> IO ()
runCommit CommitOptions{..} = case coName of
Just (T.strip -> msg)
| msg == "" -> errorMessage "Commit message cannot be empty"
| otherwise -> getCurrentIssue >>= commitCmds msg
{- if the commit name is not specified then check the branchName
If this is issue-related branch, take the issue name as the commit name.
Otherwise print errorMessage.
-}
Nothing -> do
issueNum <- getCurrentIssue
case issueNum of
Nothing -> errorMessage "Commit message cannot be empty: can not be taken from the context"
Just n -> do
title <- getIssueTitle (mkIssueId n)
commitCmds title issueNum
where
commitCmds :: Text -> Maybe Int -> IO ()
commitCmds msg issueNum = do
"git" ["add", "."]
"git" ["commit", "-m", showMsg msg $ guard hasIssue *> issueNum]
when (coPush || coIsForcePush == Force) $ runPush coIsForcePush
getCurrentIssue :: IO (Maybe Int)
getCurrentIssue = issueFromBranch <$> getCurrentBranch
showMsg :: Text -> Maybe Int -> Text
showMsg msg = \case
Nothing -> msg
Just n ->
let issue = "#" <> show n
in "[" <> issue <> "] " <> msg <> "\n\nResolves " <> issue
hasIssue :: Bool
hasIssue = not coNoIssueNumber
-- | @hit uncommit@ command
runUncommit :: IO ()
runUncommit = "git" ["reset", "HEAD~1"]
-- | @hit fix@ command
runFix :: Maybe Text -> PushBool -> IO ()
runFix msg pushBool = do
"git" ["add", "."]
"git" ["commit", "-m", message]
runPush pushBool
where
message :: Text
message = fromMaybe "Fix" msg
-- | @hit stash@ command: save all local changes to stash.
runStash :: IO ()
runStash = do
"git" ["add", "."]
"git" ["stash"]
-- | @hit unstash@ command: pop all saved changes.
runUnstash :: IO ()
runUnstash = "git" ["stash", "pop"]
-- | @hit amend@ command.
runAmend :: Bool -> IO ()
runAmend localAmend = do
"git" ["add", "."]
"git" ["commit", "--amend", "--no-edit"]
unless localAmend $ runPush Force
-- | @hit push@ command.
runPush :: PushBool -> IO ()
runPush isForce = getCurrentBranch >>= \branch ->
"git" $ ["push", "--set-upstream", "origin", branch]
++ ["--force" | isForce == Force]
-- | @hit sync@ command.
runSync :: IO ()
runSync = getCurrentBranch >>= \branch ->
"git" ["pull", "--rebase", "origin", branch]
-- | @hit resolve@ command.
runResolve :: Maybe Text -> IO ()
runResolve (nameOrMaster -> master)= do
curBranch <- getCurrentBranch
runHop $ Just master
when (curBranch /= master) $ "git" ["branch", "-D", curBranch]
-- | Remove all local changes permanently.
runClear :: PushBool -> IO ()
runClear = \case
Force -> clearChanges
Simple -> do
putText $ unlines
[ "This command permanently deletes all uncommited changes"
, "Hint: if you want to save changes, use 'hit stash' command."
, "Are you sure you want to delete changes? " <> yesOrNoText N
]
prompt N >>= \case
N -> infoMessage "Aborting local clean up"
Y -> clearChanges
where
clearChanges :: IO ()
clearChanges = do
"git" ["add", "."]
"git" ["reset", "--hard"]
{- | Part of the @hit current@ command. Prints the current branch and returns
the current issue number if possible.
-}
runCurrent :: IO (Maybe Int)
runCurrent = do
branchName <- getCurrentBranch
putTextLn $ arrow <> "Current branch: " <> greenCode <> branchName <> resetCode
pure $ issueFromBranch branchName
{- | Show stats from the given commit. If commit is not specified, uses HEAD.
-}
runStatus :: Maybe Text -> IO ()
runStatus (fromMaybe "HEAD" -> commit)
= withDeletedFiles $ withUntrackedFiles $ showPrettyDiff commit
{- | Show diff from the given commit. If commit is not specified, uses HEAD.
This commands checks whether @diff-hightligh@ is on path and if not, just calls
@git diff@.
-}
runDiff :: Maybe Text -> IO ()
runDiff (fromMaybe "HEAD" -> commit) = withUntrackedFiles $
findExecutable "diff-highlight" >>= \case
Nothing -> "git" ["diff", commit]
Just _ -> callCommand $ toString $
"git diff " <> commit <> " --color=always | diff-highlight | less -rFX"
{- | @hit clone@ command receives the name of the repo in the following
formats:
* @reponame@ — current user's username is used to clone the repo from.
* @name/reponame@ — specified GitHub username is used to clone the repo from.
__Note__ that the @ssh@ strategy is used for cloning from GitHub. See the corresponding @git@ command:
@
git clone git@github.com:username/project-name.git
@
-}
runClone :: Text -> IO ()
runClone txt = do
name <- case T.splitOn "/" txt of
[reponame] -> getUsername >>= \u -> pure $ u <> "/" <> reponame
[username, reponame] -> pure $ username <> "/" <> reponame
_ -> do
errorMessage ("Incorrect name: " <> txt <> ". Use 'repo' or 'user/repo' formats")
exitFailure
let gitLink = "git@github.com:" <> name <> ".git"
"git" ["clone", gitLink]
runLog :: Maybe Text -> IO ()
runLog (fromMaybe "HEAD" -> commit)
= "git" ["log", "--oneline", "--decorate", commit]
----------------------------------------------------------------------------
-- Internal helpers
----------------------------------------------------------------------------
-- | Get current user name from the local global git config.
getUsername :: IO Text
getUsername = do
login <- "git" $| ["config", "user.login"]
if login == ""
then errorMessage "user.login is not specified" >> exitFailure
else pure login
nameOrMaster :: Maybe Text -> Text
nameOrMaster = fromMaybe "master"
-- | Get the name of the current branch.
getCurrentBranch :: IO Text
getCurrentBranch = "git" $| ["rev-parse", "--abbrev-ref", "HEAD"]
{- | Extracts issue number from the branch in form like:
@
kowainik/<n>-short-description
@
-}
issueFromBranch :: Text -> Maybe Int
issueFromBranch =
readMaybe
. toString
. T.takeWhile isDigit
. T.drop 1
. T.dropWhile (/= '/')
{- | Perform the given action by first staging the given files and
later removing them again after the action
-}
withFiles :: IO [Text] -> IO a -> IO a
withFiles whichFiles action = bracket
addFiles
removeFiles
(const action)
where
addFiles :: IO [Text]
addFiles = do
files <- whichFiles
for_ files $ \file -> void $ "git" $| ["add", file]
pure files
-- Return files back to not spoil git state and have unexpected behavior
removeFiles :: [Text] -> IO ()
removeFiles = mapM_ $ \file -> void $ "git" $| ["reset", "--", file]
{- | Perform given action by adding all deleted files to index and returning
them back after action.
-}
withDeletedFiles :: IO a -> IO a
withDeletedFiles = withFiles deletedFiles
where
-- Find the deleted file to index so they will appear in diff
deletedFiles :: IO [Text]
deletedFiles = lines <$> "git" $| ["ls-files", "--deleted", "--exclude-standard"]
{- | Perform given action by adding all untracked files to index and returning
them back after action.
-}
withUntrackedFiles :: IO a -> IO a
withUntrackedFiles = withFiles untrackedFiles
where
-- Find the untracked file to index so they will appear in diff
untrackedFiles :: IO [Text]
untrackedFiles = lines <$> "git" $| ["ls-files", "--others", "--exclude-standard"]
import Hit.Git.Amend (runAmend)
import Hit.Git.Clear (runClear)
import Hit.Git.Clone (runClone)
import Hit.Git.Commit (runCommit)
import Hit.Git.Common (getUsername)
import Hit.Git.Current (runCurrent)
import Hit.Git.Diff (runDiff)
import Hit.Git.Fix (runFix)
import Hit.Git.Fresh (runFresh)
import Hit.Git.Hop (runHop)
import Hit.Git.Log (runLog)
import Hit.Git.New (runNew)
import Hit.Git.Push (runPush)
import Hit.Git.Resolve (runResolve)
import Hit.Git.Stash (runStash)
import Hit.Git.Status (runStatus)
import Hit.Git.Sync (runSync)
import Hit.Git.Uncommit (runUncommit)
import Hit.Git.Unstash (runUnstash)

18
src/Hit/Git/Amend.hs Normal file
View File

@ -0,0 +1,18 @@
-- | Everything related to the `hit amend` command
module Hit.Git.Amend
( runAmend
) where
import Shellmet()
import Hit.Core (PushBool (..))
import Hit.Git.Push (runPush)
-- | @hit amend@ command.
runAmend :: Bool -> IO ()
runAmend localAmend = do
"git" ["add", "."]
"git" ["commit", "--amend", "--no-edit"]
unless localAmend $ runPush Force

30
src/Hit/Git/Clear.hs Normal file
View File

@ -0,0 +1,30 @@
-- | Everything related to the `hit clear` command
module Hit.Git.Clear
( runClear
) where
import Shellmet()
import Hit.ColorTerminal (Answer (..), infoMessage, prompt, yesOrNoText)
import Hit.Core (PushBool (..))
-- | Remove all local changes permanently.
runClear :: PushBool -> IO ()
runClear = \case
Force -> clearChanges
Simple -> do
putText $ unlines
[ "This command permanently deletes all uncommited changes"
, "Hint: if you want to save changes, use 'hit stash' command."
, "Are you sure you want to delete changes? " <> yesOrNoText N
]
prompt N >>= \case
N -> infoMessage "Aborting local clean up"
Y -> clearChanges
where
clearChanges :: IO ()
clearChanges = do
"git" ["add", "."]
"git" ["reset", "--hard"]

36
src/Hit/Git/Clone.hs Normal file
View File

@ -0,0 +1,36 @@
-- | Everything related to the `hit clone` command
module Hit.Git.Clone
( runClone
) where
import Shellmet()
import Hit.ColorTerminal (errorMessage)
import Hit.Git.Common (getUsername)
import qualified Data.Text as T
{- | @hit clone@ command receives the name of the repo in the following
formats:
* @reponame@ — current user's username is used to clone the repo from.
* @name/reponame@ — specified GitHub username is used to clone the repo from.
__Note__ that the @ssh@ strategy is used for cloning from GitHub. See the corresponding @git@ command:
@
git clone git@github.com:username/project-name.git
@
-}
runClone :: Text -> IO ()
runClone txt = do
name <- case T.splitOn "/" txt of
[reponame] -> getUsername >>= \u -> pure $ u <> "/" <> reponame
[username, reponame] -> pure $ username <> "/" <> reponame
_ -> do
errorMessage ("Incorrect name: " <> txt <> ". Use 'repo' or 'user/repo' formats")
exitFailure
let gitLink = "git@github.com:" <> name <> ".git"
"git" ["clone", gitLink]

53
src/Hit/Git/Commit.hs Normal file
View File

@ -0,0 +1,53 @@
-- | Everything related to the `hit commit` command
module Hit.Git.Commit
( runCommit
) where
import Shellmet()
import Hit.ColorTerminal (errorMessage)
import Hit.Core (CommitOptions (..), PushBool (..))
import Hit.Issue (getIssueTitle, mkIssueId)
import Hit.Git.Common (issueFromBranch, getCurrentBranch)
import Hit.Git.Push (runPush)
import qualified Data.Text as T
-- | @hit commit@ command.
runCommit :: CommitOptions -> IO ()
runCommit CommitOptions{..} = case coName of
Just (T.strip -> msg)
| msg == "" -> errorMessage "Commit message cannot be empty"
| otherwise -> getCurrentIssue >>= commitCmds msg
{- if the commit name is not specified then check the branchName
If this is issue-related branch, take the issue name as the commit name.
Otherwise print errorMessage.
-}
Nothing -> do
issueNum <- getCurrentIssue
case issueNum of
Nothing -> errorMessage "Commit message cannot be empty: can not be taken from the context"
Just n -> do
title <- getIssueTitle (mkIssueId n)
commitCmds title issueNum
where
commitCmds :: Text -> Maybe Int -> IO ()
commitCmds msg issueNum = do
"git" ["add", "."]
"git" ["commit", "-m", showMsg msg $ guard hasIssue *> issueNum]
when (coPush || coIsForcePush == Force) $ runPush coIsForcePush
getCurrentIssue :: IO (Maybe Int)
getCurrentIssue = issueFromBranch <$> getCurrentBranch
showMsg :: Text -> Maybe Int -> Text
showMsg msg = \case
Nothing -> msg
Just n ->
let issue = "#" <> show n
in "[" <> issue <> "] " <> msg <> "\n\nResolves " <> issue
hasIssue :: Bool
hasIssue = not coNoIssueNumber

89
src/Hit/Git/Common.hs Normal file
View File

@ -0,0 +1,89 @@
{- | Functions which can be used by serveral Hit Commands
and are not specific to one.
-}
module Hit.Git.Common
( nameOrMaster
, getUsername
, getCurrentBranch
, issueFromBranch
, withDeletedFiles
, withUntrackedFiles
) where
import Control.Exception (bracket)
import Data.Char (isDigit)
import Shellmet (($|))
import Hit.ColorTerminal (errorMessage)
import qualified Data.Text as T
nameOrMaster :: Maybe Text -> Text
nameOrMaster = fromMaybe "master"
-- | Get current user name from the local global git config.
getUsername :: IO Text
getUsername = do
login <- "git" $| ["config", "user.login"]
if login == ""
then errorMessage "user.login is not specified" >> exitFailure
else pure login
-- | Get the name of the current branch.
getCurrentBranch :: IO Text
getCurrentBranch = "git" $| ["rev-parse", "--abbrev-ref", "HEAD"]
{- | Extracts issue number from the branch in form like:
@
kowainik/<n>-short-description
@
-}
issueFromBranch :: Text -> Maybe Int
issueFromBranch =
readMaybe
. toString
. T.takeWhile isDigit
. T.drop 1
. T.dropWhile (/= '/')
{- | Perform the given action by first staging the given files and
later removing them again after the action
-}
withFiles :: IO [Text] -> IO a -> IO a
withFiles whichFiles action = bracket
addFiles
removeFiles
(const action)
where
addFiles :: IO [Text]
addFiles = do
files <- whichFiles
for_ files $ \file -> void $ "git" $| ["add", file]
pure files
-- Return files back to not spoil git state and have unexpected behavior
removeFiles :: [Text] -> IO ()
removeFiles = mapM_ $ \file -> void $ "git" $| ["reset", "--", file]
{- | Perform given action by adding all deleted files to index and returning
them back after action.
-}
withDeletedFiles :: IO a -> IO a
withDeletedFiles = withFiles deletedFiles
where
-- Find the deleted file to index so they will appear in diff
deletedFiles :: IO [Text]
deletedFiles = lines <$> "git" $| ["ls-files", "--deleted", "--exclude-standard"]
{- | Perform given action by adding all untracked files to index and returning
them back after action.
-}
withUntrackedFiles :: IO a -> IO a
withUntrackedFiles = withFiles untrackedFiles
where
-- Find the untracked file to index so they will appear in diff
untrackedFiles :: IO [Text]
untrackedFiles = lines <$> "git" $| ["ls-files", "--others", "--exclude-standard"]

18
src/Hit/Git/Current.hs Normal file
View File

@ -0,0 +1,18 @@
-- | Everything related to the `hit current` command
module Hit.Git.Current
( runCurrent
) where
import Hit.ColorTerminal (arrow, greenCode, resetCode)
import Hit.Git.Common (getCurrentBranch, issueFromBranch)
{- | Part of the @hit current@ command. Prints the current branch and returns
the current issue number if possible.
-}
runCurrent :: IO (Maybe Int)
runCurrent = do
branchName <- getCurrentBranch
putTextLn $ arrow <> "Current branch: " <> greenCode <> branchName <> resetCode
pure $ issueFromBranch branchName

23
src/Hit/Git/Diff.hs Normal file
View File

@ -0,0 +1,23 @@
-- | Everything related to the `hit diff` command
module Hit.Git.Diff
( runDiff
) where
import Shellmet()
import System.Directory (findExecutable)
import System.Process (callCommand)
import Hit.Git.Common (withUntrackedFiles)
{- | Show diff from the given commit. If commit is not specified, uses HEAD.
This commands checks whether @diff-hightligh@ is on path and if not, just calls
@git diff@.
-}
runDiff :: Maybe Text -> IO ()
runDiff (fromMaybe "HEAD" -> commit) = withUntrackedFiles $
findExecutable "diff-highlight" >>= \case
Nothing -> "git" ["diff", commit]
Just _ -> callCommand $ toString $
"git diff " <> commit <> " --color=always | diff-highlight | less -rFX"

21
src/Hit/Git/Fix.hs Normal file
View File

@ -0,0 +1,21 @@
-- | Everything related to the `hit fix` command
module Hit.Git.Fix
( runFix
) where
import Shellmet()
import Hit.Core (PushBool (..))
import Hit.Git.Push (runPush)
-- | @hit fix@ command
runFix :: Maybe Text -> PushBool -> IO ()
runFix msg pushBool = do
"git" ["add", "."]
"git" ["commit", "-m", message]
runPush pushBool
where
message :: Text
message = fromMaybe "Fix" msg

16
src/Hit/Git/Fresh.hs Normal file
View File

@ -0,0 +1,16 @@
-- | Everything related to the `hit fresh` command
module Hit.Git.Fresh
( runFresh
) where
import Shellmet()
import Hit.Git.Common (nameOrMaster)
-- | @hit fresh@ command.
runFresh :: Maybe Text -> IO ()
runFresh (nameOrMaster -> branch) = do
"git" ["fetch", "origin", branch]
"git" ["rebase", "origin/" <> branch]

16
src/Hit/Git/Hop.hs Normal file
View File

@ -0,0 +1,16 @@
-- | Everything related to the `hit hop` command
module Hit.Git.Hop
( runHop
) where
import Shellmet()
import Hit.Git.Common (nameOrMaster)
-- | @hit hop@ command.
runHop :: Maybe Text -> IO ()
runHop (nameOrMaster -> branch) = do
"git" ["checkout", branch]
"git" ["pull", "--rebase", "--prune"]

13
src/Hit/Git/Log.hs Normal file
View File

@ -0,0 +1,13 @@
-- | Everything related to the `hit log` command
module Hit.Git.Log
( runLog
) where
import Shellmet()
-- | @hit log@ command.
runLog :: Maybe Text -> IO ()
runLog (fromMaybe "HEAD" -> commit)
= "git" ["log", "--oneline", "--decorate", commit]

89
src/Hit/Git/New.hs Normal file
View File

@ -0,0 +1,89 @@
-- | Everything related to the `hit new` command
module Hit.Git.New
( runNew
) where
import Data.Char (isAlphaNum, isDigit, isSpace)
import GitHub (Issue (issueNumber), IssueNumber (..), unIssueNumber)
import Hit.ColorTerminal (errorMessage, infoMessage, successMessage)
import Hit.Issue (createIssue, getIssueTitle, mkIssueId)
import Hit.Git.Common (getUsername)
import qualified Data.Text as T
-- | @hit new@ command.
runNew :: Bool -> Text -> IO ()
runNew isIssue issueOrName = do
login <- getUsername
maybeIssue <- if isIssue then tryCreateNewIssue login else pure Nothing
let branchDescription = mkBranchDescription maybeIssue issueOrName
title <- displayBranchDescription branchDescription
let branchName = login <> "/" <> title
"git" ["checkout", "-b", branchName]
where
tryCreateNewIssue :: Text -> IO (Maybe IssueNumber)
tryCreateNewIssue login = do
infoMessage $ "Creating issue with title: '" <> issueOrName <> "'"
createIssue issueOrName login >>= \case
Left err -> do
errorMessage "Error creating issue under 'hit new' command!"
putTextLn $ show err
pure Nothing
Right issue -> do
let issueNum = issueNumber issue
successMessage $ "Successfully created issue number #"
<> show (unIssueNumber issueNum)
pure $ Just issueNum
{- | This data type represents all cases on how to create short branch
name description. During 'hit new' command there can be several cases:
1. 'FromNewIssue': when new issue is created, we know its title and number.
2. 'FromIssueNumber': if issue is not created, we need to fetch its title by id.
3. 'FromText': if not issue number is provided, we just create raw text.
-}
data BranchDescription
= FromNewIssue Int Text
| FromIssueNumber Int
| FromText Text
-- | Create 'BranchTitle' from possible issue and issue number or text.
mkBranchDescription :: Maybe IssueNumber -> Text -> BranchDescription
mkBranchDescription (Just issueNum) title = FromNewIssue (unIssueNumber issueNum) title
mkBranchDescription Nothing issueOrName = case readMaybe @Int $ toString issueOrName of
Just issueNum -> FromIssueNumber issueNum
Nothing -> FromText issueOrName
{- | Display 'BranchDescription' in format:
@
123-short-issue-title
@
-}
displayBranchDescription :: BranchDescription -> IO Text
displayBranchDescription = \case
FromText text -> pure $ mkShortDesc text
FromNewIssue issueNum issueTitle -> pure $ nameWithNumber issueNum issueTitle
FromIssueNumber issueNum -> do
issueTitle <- getIssueTitle $ mkIssueId issueNum
pure $ nameWithNumber issueNum issueTitle
where
nameWithNumber :: Int -> Text -> Text
nameWithNumber issueNum issueTitle =
show issueNum <> "-" <> mkShortDesc issueTitle
mkShortDesc :: Text -> Text
mkShortDesc =
T.intercalate "-"
. take 5
. words
. T.filter (\c -> isAlphaNum c
|| isDigit c
|| isSpace c
|| c `elem` ("_-./" :: String)
)

17
src/Hit/Git/Push.hs Normal file
View File

@ -0,0 +1,17 @@
-- | Everything related to the `hit push` command
module Hit.Git.Push
( runPush
) where
import Shellmet()
import Hit.Core (PushBool (..))
import Hit.Git.Common (getCurrentBranch)
-- | @hit push@ command.
runPush :: PushBool -> IO ()
runPush isForce = getCurrentBranch >>= \branch ->
"git" $ ["push", "--set-upstream", "origin", branch]
++ ["--force" | isForce == Force]

18
src/Hit/Git/Resolve.hs Normal file
View File

@ -0,0 +1,18 @@
-- | Everything related to the `hit resolve` command
module Hit.Git.Resolve
( runResolve
) where
import Shellmet()
import Hit.Git.Hop (runHop)
import Hit.Git.Common (nameOrMaster, getCurrentBranch)
-- | @hit resolve@ command.
runResolve :: Maybe Text -> IO ()
runResolve (nameOrMaster -> master)= do
curBranch <- getCurrentBranch
runHop $ Just master
when (curBranch /= master) $ "git" ["branch", "-D", curBranch]

14
src/Hit/Git/Stash.hs Normal file
View File

@ -0,0 +1,14 @@
-- | Everything related to the `hit stash` command
module Hit.Git.Stash
( runStash
) where
import Shellmet()
-- | @hit stash@ command: save all local changes to stash.
runStash :: IO ()
runStash = do
"git" ["add", "."]
"git" ["stash"]

15
src/Hit/Git/Status.hs
View File

@ -3,19 +3,26 @@ in pretty way.
-}
module Hit.Git.Status
( showPrettyDiff
( runStatus
) where
import Shellmet (($?), ($|))
import System.Process (callCommand)
import Hit.ColorTerminal (blueCode, boldCode, cyanCode, greenCode, magentaCode, redCode, resetCode,
yellowCode)
import qualified Hit.Formatting as Fmt
import Hit.ColorTerminal (blueCode, boldCode, cyanCode, greenCode, magentaCode
, redCode, resetCode, yellowCode)
import Hit.Git.Common (withDeletedFiles, withUntrackedFiles)
import qualified Hit.Formatting as Fmt
import qualified Data.Text as T
{- | Show stats from the given commit. If commit is not specified, uses HEAD.
-}
runStatus :: Maybe Text -> IO ()
runStatus (fromMaybe "HEAD" -> commit)
= withDeletedFiles $ withUntrackedFiles $ showPrettyDiff commit
-- | Enum that represents all possible types of file modifications.
data PatchType
= Added

15
src/Hit/Git/Sync.hs Normal file
View File

@ -0,0 +1,15 @@
-- | Everything related to the `hit sync` command
module Hit.Git.Sync
( runSync
) where
import Shellmet()
import Hit.Git.Common (getCurrentBranch)
-- | @hit sync@ command.
runSync :: IO ()
runSync = getCurrentBranch >>= \branch ->
"git" ["pull", "--rebase", "origin", branch]

12
src/Hit/Git/Uncommit.hs Normal file
View File

@ -0,0 +1,12 @@
-- | Everything related to the `hit uncommit` command
module Hit.Git.Uncommit
( runUncommit
) where
import Shellmet()
-- | @hit uncommit@ command
runUncommit :: IO ()
runUncommit = "git" ["reset", "HEAD~1"]

12
src/Hit/Git/Unstash.hs Normal file
View File

@ -0,0 +1,12 @@
-- | Everything related to the `hit unstash` command
module Hit.Git.Unstash
( runUnstash
) where
import Shellmet()
-- | @hit unstash@ command: pop all saved changes.
runUnstash :: IO ()
runUnstash = "git" ["stash", "pop"]