From 699a75914059a443b6ba93479aedca39fbbfd95e Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Sat, 1 Sep 2018 23:47:42 +0200 Subject: [PATCH] Interactive new issue --- gpm.cabal | 4 +- package.yaml | 1 + src/GPM.hs | 13 +++--- src/GPM/Init.hs | 2 + src/GPM/Issue.hs | 111 ++++++++++++++++++++++++++++++++++++----------- 5 files changed, 98 insertions(+), 33 deletions(-) diff --git a/gpm.cabal b/gpm.cabal index 05eee24..4543366 100644 --- a/gpm.cabal +++ b/gpm.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: f13ce9cfb72ed8d7e916b9e6cf99111cfd7fbe4bc5083fb018698023360414db +-- hash: ab6ea5ad975f268ebb05939f453aeb3f190183a3472aaa84b76871d4f1b09e05 name: gpm version: 0.1.0.0 @@ -39,6 +39,7 @@ library , foldl , mustache , protolude + , text , turtle default-language: Haskell2010 @@ -57,5 +58,6 @@ executable gpm , gpm , mustache , protolude + , text , turtle default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index d8ebd80..b607063 100644 --- a/package.yaml +++ b/package.yaml @@ -29,6 +29,7 @@ dependencies: - file-embed - foldl - mustache +- text library: source-dirs: src executables: diff --git a/src/GPM.hs b/src/GPM.hs index 40eb745..6187aa2 100755 --- a/src/GPM.hs +++ b/src/GPM.hs @@ -22,18 +22,19 @@ gpm :: IO () gpm = do subcmd <- options "Git Project Manager" parser case subcmd of - Init -> Init.init - NewIssue -> inGPM Issue.handleNewIssue - Review reviewCmd -> inGPM (Review.handleReview reviewCmd) + Init -> Init.init + NewIssue issueOpt -> inGPM (Issue.handleNewIssue issueOpt) + Review reviewCmd -> inGPM (Review.handleReview reviewCmd) data Command = Init - | NewIssue + | NewIssue Issue.IssueOptions | Review Review.ReviewCommand - deriving (Eq) parser :: Parser Command parser = subcommand "init" "Initialize gpm" (pure Init) - <|> subcommand "new-issue" "Create a new Issue" (pure NewIssue) + <|> NewIssue <$> subcommand "new-issue" + "Create a new Issue" + Issue.parseIssueOptions <|> Review <$> subcommand "review" "Review (use current branch by default)" Review.parseReviewCmd diff --git a/src/GPM/Init.hs b/src/GPM/Init.hs index a39cc4f..3e911df 100644 --- a/src/GPM/Init.hs +++ b/src/GPM/Init.hs @@ -19,6 +19,7 @@ import qualified GPM.Docs as Docs import qualified GPM.Issue as Issue import qualified GPM.Review as Review +-- | Init a repository with a new empty branch named @gpm@ init :: IO () init = do echo "# -- Git Project Manager" @@ -29,6 +30,7 @@ init = do debug_ "git commit -m 'gpm initialized'" debug_ "git checkout master" +-- | Create a new empty branch, fail if the branch already exists mkNewEmptyBranch :: Text -> IO () mkNewEmptyBranch br = do putText $ "create a new branch " <> br <> " (be sure the branch " <> br <> " doesn't already exists)" diff --git a/src/GPM/Issue.hs b/src/GPM/Issue.hs index 9ebde3c..59b8488 100644 --- a/src/GPM/Issue.hs +++ b/src/GPM/Issue.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -12,28 +13,75 @@ Maintainer : yann.esposito@gmail.com module GPM.Issue ( init , handleNewIssue + , parseIssueOptions + , IssueOptions(..) ) where -import Protolude hiding (die) +import Protolude hiding (ask,die) import Turtle import Data.FileEmbed (embedStringFile) +import qualified Data.Text as T import GPM.Helpers import Text.Mustache +data IssueOptions = IssueOptions + { interactive :: Bool + , newIssue :: NewIssue + } + + +parseIssueOptions :: Parser IssueOptions +parseIssueOptions = IssueOptions + <$> switch "interactive" 'i' "Interactive mode" + <*> parseNewIssue + +parseNewIssue :: Parser NewIssue +parseNewIssue = do + isPriority <- optional $ optText "priority" 'p' "Priority A,B,C" + isStatus <- optional $ optText "status" 's' "The status of the issue (TODO, QUESTION, ...)" + isTitle <- optional $ optText "title" 't' "The status title" + isUser <- optional $ optText "creator" 'c' "The user that created the issue" + isBranch <- optional $ optText "branch" 'b' "The branch related to the issue" + isTags <- optional $ optText "tags" 'g' "comma separated tags" + isAssignee <- optional $ optText "assignee" 'a' "Assignee" + isReviewers <- optional $ optText "reviewers" 'r' "comma separated reviewers" + isDescription <- optional $ optText "descr" 'd' "Long issue description" + pure NewIssue { priority = maybe PriorityB toPriority isPriority + , status = fromMaybe "TODO" isStatus + , title = fromMaybe "Issue Title" isTitle + , user = isUser + , branch = isBranch + , tags = maybe [] (T.splitOn ",") isTags + , assignee = isAssignee + , reviewers = maybe [] (T.splitOn ",") isReviewers + , description = isDescription + } + +toPriority :: Text -> Priority +toPriority "A" = PriorityA +toPriority "B" = PriorityB +toPriority "C" = PriorityC +toPriority _ = PriorityB + data NewIssue = NewIssue { priority :: Priority , status :: Text , title :: Text - , user :: User + , user :: Maybe User , branch :: Maybe Text , tags :: [Text] , assignee :: Maybe User , reviewers :: [User] - , description :: Text + , description :: Maybe Text } -data Priority = PriorityA | PriorityB | PriorityC + +data Priority = PriorityA + | PriorityB + | PriorityC + deriving (Eq,Ord) + type User = Text priorityToText :: Priority -> Text @@ -63,36 +111,47 @@ createTmpNewIssue ni = do die "Parse ERROR, check your template ./templates/new-issue.org" Right compiled -> writeFile ".issues.org.tmp" (substitute compiled ni) -handleNewIssue :: IO () -handleNewIssue = do - newIssue <- gatherNewIssueInfos +handleNewIssue :: IssueOptions -> IO () +handleNewIssue opts = do + newIssueTmp <- gatherNewIssueInfos (newIssue opts) + newIssue <- if interactive opts + then interactiveNewIssue newIssueTmp + else return newIssueTmp createTmpNewIssue newIssue validTmpNewIssue +interactiveNewIssue :: NewIssue -> IO NewIssue +interactiveNewIssue _ = + NewIssue <$> (fromMaybe PriorityB <$> ask "priority" "ex: A,B,C" toPriority) + <*> (fromMaybe "TODO" <$> ask "status" "ex: TODO, QUESTION" identity) + <*> (fromMaybe "Issue title" <$> ask "title" "Short Description" identity) + <*> ask "user" "your nick" identity + <*> ask "branch" "related branch" identity + <*> (fromMaybe [] <$> ask "tags" "comma separated tags" (T.splitOn ",")) + <*> ask "assignee" "a single nick" identity + <*> (fromMaybe [] <$> ask "reviewers" "comma separated nicks" (T.splitOn ",")) + <*> ask "description" "the long description" identity + where + ask :: Text -> Text -> (Text -> a) -> IO (Maybe a) + ask field ex tr = do + putText $ "Please enter " <> field <> "("<> ex <>"): " + fmap (tr . lineToText) <$> readline + validTmpNewIssue :: IO () validTmpNewIssue = do tmpIssue <- readFile ".issues.org.tmp" appendFile "issues.org" ("\n\n" <> tmpIssue) -defaultNewIssue :: NewIssue -defaultNewIssue = NewIssue - { priority = PriorityB - , status = "TODO" - , title = "Issue Title" - , user = "Unknown User" - , branch = Nothing - , tags = [] - , assignee = Nothing - , reviewers = [] - , description = "Write a comprehensive issue description..." - } - -gatherNewIssueInfos :: IO NewIssue -gatherNewIssueInfos = do - user <- getGitUser - branch <- getCurrentGitBranch - return $ defaultNewIssue { user = fromMaybe "Unknown User" user - , branch = branch } +gatherNewIssueInfos :: NewIssue -> IO NewIssue +gatherNewIssueInfos iss = do + user <- if isNothing (user iss) + then getGitUser + else return (user iss) + branch <- if isNothing (branch iss) + then getCurrentGitBranch + else return (branch iss) + return $ iss { user = user + , branch = branch } init :: IO () init = do