diff --git a/src/GPM.hs b/src/GPM.hs index 3e8a379..40eb745 100755 --- a/src/GPM.hs +++ b/src/GPM.hs @@ -23,7 +23,7 @@ gpm = do subcmd <- options "Git Project Manager" parser case subcmd of Init -> Init.init - NewIssue -> inGPM Issue.newIssue + NewIssue -> inGPM Issue.handleNewIssue Review reviewCmd -> inGPM (Review.handleReview reviewCmd) data Command = Init diff --git a/src/GPM/Docs.hs b/src/GPM/Docs.hs index aa9081f..d4631fe 100644 --- a/src/GPM/Docs.hs +++ b/src/GPM/Docs.hs @@ -16,10 +16,10 @@ import Turtle import Data.FileEmbed (embedStringFile) -import GPM.Helpers (debug) +import GPM.Helpers (debug_) init :: IO () init = do echo "* wiki.org" output "wiki.org" $(embedStringFile "templates/wiki.org") - debug "git add wiki.org" + debug_ "git add wiki.org" diff --git a/src/GPM/Helpers.hs b/src/GPM/Helpers.hs index 5b6db4f..0d253bd 100644 --- a/src/GPM/Helpers.hs +++ b/src/GPM/Helpers.hs @@ -1,6 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} {-| module : GPM.Helpers Description : GPM helper functions @@ -8,32 +7,44 @@ License : Public Domain Maintainer : yann.esposito@gmail.com -} module GPM.Helpers - (debug,inGPM) + (debug,debug_,inGPM,getCurrentGitBranch,getGitUser) where -import Protolude hiding (stdout,fold,die) +import Protolude hiding (die) import Turtle import qualified Control.Foldl as Fold -debug :: Text -> IO () +-- | execute a shell script and return the last line as text +-- but also log the command to the console to minimize surprise +debug :: Text -> IO (Maybe Text) debug cmd = do putText cmd - stdout $ inshell cmd empty + fmap lineToText <$> _foldIO (inshell cmd empty) (Fold.generalize Fold.last) + +-- | execute a shell script without stdin and without handling output +debug_ :: Text -> IO () +debug_ = void . debug + +getCurrentGitBranch :: IO (Maybe Text) +getCurrentGitBranch = debug "git rev-parse --abbrev-ref HEAD" + +getGitUser :: IO (Maybe Text) +getGitUser = debug "git config user.name" -- | Ensure actions occurs in the @gpm@ branch -- and returns to current branch with also all untracked files -inGPM :: MonadIO io => IO a -> io () -inGPM actions = sh $ do - res <- fold (inshell "git rev-parse --abbrev-ref HEAD" empty) Fold.head - oldbr <- case res of - Nothing -> die "Cannot retrieve current branch" - Just br -> do - void $ inshell "git stash --all" empty - void $ inshell "git checkout gpm" empty - return br - liftIO $ bracket (return ()) - (const $ sh $ do - void $ inshell ("git checkout " <> lineToText oldbr) empty - void $ inshell "git stash pop" empty) - (const actions) +inGPM :: IO a -> IO a +inGPM actions = bracket safeChangeBranch safeReturnBranch (const actions) + where + safeChangeBranch = do + res <- getCurrentGitBranch + case res of + Nothing -> die "Cannot retrieve current branch" + Just br -> do + debug_ "git stash --all" + debug_ "git checkout gpm" + return br + safeReturnBranch oldbr = do + debug_ ("git checkout " <> oldbr) + debug_ "git stash pop" diff --git a/src/GPM/Init.hs b/src/GPM/Init.hs index 9217405..a39cc4f 100644 --- a/src/GPM/Init.hs +++ b/src/GPM/Init.hs @@ -1,6 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} {-| module : GPM.Init @@ -15,7 +14,7 @@ where import Protolude import Turtle -import GPM.Helpers (debug) +import GPM.Helpers (debug_) import qualified GPM.Docs as Docs import qualified GPM.Issue as Issue import qualified GPM.Review as Review @@ -27,13 +26,13 @@ init = do Issue.init Docs.init Review.init - debug "git commit -m 'gpm initialized'" - debug "git checkout master" + debug_ "git commit -m 'gpm initialized'" + debug_ "git checkout master" mkNewEmptyBranch :: Text -> IO () mkNewEmptyBranch br = do putText $ "create a new branch " <> br <> " (be sure the branch " <> br <> " doesn't already exists)" - debug $ "git checkout --orphan " <> br + debug_ $ "git checkout --orphan " <> br echo "cleanup the branch" - debug "git rm --cached -r ." + debug_ "git rm --cached -r ." diff --git a/src/GPM/Issue.hs b/src/GPM/Issue.hs index 912ae9d..9ebde3c 100644 --- a/src/GPM/Issue.hs +++ b/src/GPM/Issue.hs @@ -1,5 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-| @@ -10,7 +11,7 @@ Maintainer : yann.esposito@gmail.com -} module GPM.Issue ( init - , newIssue + , handleNewIssue ) where @@ -18,9 +19,80 @@ import Protolude hiding (die) import Turtle import Data.FileEmbed (embedStringFile) +import GPM.Helpers +import Text.Mustache -newIssue :: IO () -newIssue = die "TODO" +data NewIssue = + NewIssue { priority :: Priority + , status :: Text + , title :: Text + , user :: User + , branch :: Maybe Text + , tags :: [Text] + , assignee :: Maybe User + , reviewers :: [User] + , description :: Text + } +data Priority = PriorityA | PriorityB | PriorityC +type User = Text + +priorityToText :: Priority -> Text +priorityToText PriorityA = "[#A]" +priorityToText PriorityB = "[#B]" +priorityToText PriorityC = "[#C]" + +instance ToMustache NewIssue where + toMustache NewIssue{..} = object + [ "priority" ~> priorityToText priority + , "status" ~> status + , "title" ~> title + , "user" ~> user + , "branch" ~> branch + , "tags" ~> tags + , "assignee" ~> assignee + , "reviewers" ~> reviewers + , "description" ~> description + ] + +createTmpNewIssue :: NewIssue -> IO () +createTmpNewIssue ni = do + ecompiled <- automaticCompile ["./templates"] "new-issue.org" + case ecompiled of + Left pe -> do + print pe + 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 + createTmpNewIssue newIssue + validTmpNewIssue + +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 } init :: IO () init = do diff --git a/src/GPM/Review.hs b/src/GPM/Review.hs index 86e02b4..025f057 100644 --- a/src/GPM/Review.hs +++ b/src/GPM/Review.hs @@ -20,7 +20,7 @@ import Protolude hiding (die, (%)) import Turtle import Data.FileEmbed (embedStringFile) -import GPM.Helpers (debug) +import GPM.Helpers (debug_) data ReviewCommand = ReviewStart (Maybe Text) | ReviewStop (Maybe Text) @@ -37,7 +37,7 @@ init = do mktree "reviews" putText $ format ("* "%fp) fic output fic $(embedStringFile "templates/review.org") - debug "git add reviews" + debug_ "git add reviews" parseReviewCmd :: Parser ReviewCommand