Better code organization
This commit is contained in:
parent
ed5d5c6b85
commit
b32dff64a1
6 changed files with 115 additions and 33 deletions
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
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
|
||||
void $ inshell "git stash --all" empty
|
||||
void $ inshell "git checkout gpm" empty
|
||||
debug_ "git stash --all"
|
||||
debug_ "git checkout gpm"
|
||||
return br
|
||||
liftIO $ bracket (return ())
|
||||
(const $ sh $ do
|
||||
void $ inshell ("git checkout " <> lineToText oldbr) empty
|
||||
void $ inshell "git stash pop" empty)
|
||||
(const actions)
|
||||
safeReturnBranch oldbr = do
|
||||
debug_ ("git checkout " <> oldbr)
|
||||
debug_ "git stash pop"
|
||||
|
|
|
@ -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 ."
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue