Better code organization

This commit is contained in:
Yann Esposito (Yogsototh) 2018-09-01 19:35:30 +02:00
parent ed5d5c6b85
commit b32dff64a1
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
6 changed files with 115 additions and 33 deletions

View file

@ -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

View file

@ -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"

View file

@ -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"

View file

@ -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 ."

View file

@ -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

View file

@ -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