Splited, one file per subcommand
This commit is contained in:
parent
6a29162c87
commit
ed5d5c6b85
9 changed files with 188 additions and 73 deletions
|
@ -2,7 +2,7 @@
|
||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: c6d39ec4e6cb0558da69c75830e9471b116c0dfabc6cdbaaefa819cea92298b1
|
-- hash: f13ce9cfb72ed8d7e916b9e6cf99111cfd7fbe4bc5083fb018698023360414db
|
||||||
|
|
||||||
name: gpm
|
name: gpm
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
|
@ -22,6 +22,10 @@ extra-source-files:
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
GPM
|
GPM
|
||||||
|
GPM.Docs
|
||||||
|
GPM.Helpers
|
||||||
|
GPM.Init
|
||||||
|
GPM.Issue
|
||||||
GPM.Review
|
GPM.Review
|
||||||
other-modules:
|
other-modules:
|
||||||
Paths_gpm
|
Paths_gpm
|
||||||
|
@ -33,6 +37,7 @@ library
|
||||||
base >=4.8 && <5
|
base >=4.8 && <5
|
||||||
, file-embed
|
, file-embed
|
||||||
, foldl
|
, foldl
|
||||||
|
, mustache
|
||||||
, protolude
|
, protolude
|
||||||
, turtle
|
, turtle
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -50,6 +55,7 @@ executable gpm
|
||||||
, file-embed
|
, file-embed
|
||||||
, foldl
|
, foldl
|
||||||
, gpm
|
, gpm
|
||||||
|
, mustache
|
||||||
, protolude
|
, protolude
|
||||||
, turtle
|
, turtle
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -28,6 +28,7 @@ dependencies:
|
||||||
- turtle
|
- turtle
|
||||||
- file-embed
|
- file-embed
|
||||||
- foldl
|
- foldl
|
||||||
|
- mustache
|
||||||
library:
|
library:
|
||||||
source-dirs: src
|
source-dirs: src
|
||||||
executables:
|
executables:
|
||||||
|
|
85
src/GPM.hs
85
src/GPM.hs
|
@ -1,29 +1,34 @@
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-|
|
||||||
|
module : GPM
|
||||||
|
Description : GPM command line function
|
||||||
|
License : Public Domain
|
||||||
|
Maintainer : yann.esposito@gmail.com
|
||||||
|
-}
|
||||||
module GPM
|
module GPM
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.FileEmbed (embedStringFile)
|
import Protolude hiding (stdout)
|
||||||
import Protolude hiding (die, stdout, (%),fold)
|
|
||||||
import Turtle
|
import Turtle
|
||||||
import qualified Control.Foldl as Fold
|
|
||||||
import Control.Exception.Base (bracket)
|
|
||||||
|
|
||||||
import GPM.Review (ReviewCommand (..), handleReview,
|
|
||||||
parseReviewCmd)
|
import GPM.Helpers (inGPM)
|
||||||
|
import qualified GPM.Init as Init
|
||||||
|
import qualified GPM.Issue as Issue
|
||||||
|
import qualified GPM.Review as Review
|
||||||
|
|
||||||
gpm :: IO ()
|
gpm :: IO ()
|
||||||
gpm = do
|
gpm = do
|
||||||
subcmd <- options "Git Project Manager" parser
|
subcmd <- options "Git Project Manager" parser
|
||||||
case subcmd of
|
case subcmd of
|
||||||
Init -> init
|
Init -> Init.init
|
||||||
NewIssue -> inGPM newIssue
|
NewIssue -> inGPM Issue.newIssue
|
||||||
Review reviewCmd -> inGPM (handleReview reviewCmd)
|
Review reviewCmd -> inGPM (Review.handleReview reviewCmd)
|
||||||
|
|
||||||
data Command = Init
|
data Command = Init
|
||||||
| NewIssue
|
| NewIssue
|
||||||
| Review ReviewCommand
|
| Review Review.ReviewCommand
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
||||||
parser :: Parser Command
|
parser :: Parser Command
|
||||||
|
@ -31,65 +36,9 @@ parser = subcommand "init" "Initialize gpm" (pure Init)
|
||||||
<|> subcommand "new-issue" "Create a new Issue" (pure NewIssue)
|
<|> subcommand "new-issue" "Create a new Issue" (pure NewIssue)
|
||||||
<|> Review <$> subcommand "review"
|
<|> Review <$> subcommand "review"
|
||||||
"Review (use current branch by default)"
|
"Review (use current branch by default)"
|
||||||
parseReviewCmd
|
Review.parseReviewCmd
|
||||||
|
|
||||||
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)
|
|
||||||
|
|
||||||
newIssue :: IO ()
|
|
||||||
newIssue = die "TODO"
|
|
||||||
|
|
||||||
init :: IO ()
|
|
||||||
init = do
|
|
||||||
echo "# <GPM> -- Git Project Manager"
|
|
||||||
mkNewEmptyBranch "gpm"
|
|
||||||
initIssues
|
|
||||||
initDocs
|
|
||||||
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
|
|
||||||
echo "cleanup the branch"
|
|
||||||
debug "git rm --cached -r ."
|
|
||||||
|
|
||||||
debug :: Text -> IO ()
|
debug :: Text -> IO ()
|
||||||
debug cmd = do
|
debug cmd = do
|
||||||
putText cmd
|
putText cmd
|
||||||
stdout $ inshell cmd empty
|
stdout $ inshell cmd empty
|
||||||
|
|
||||||
initIssues :: IO ()
|
|
||||||
initIssues = do
|
|
||||||
echo "* issue.org"
|
|
||||||
output "issues.org" $(embedStringFile "templates/issues.org")
|
|
||||||
mktree "templates"
|
|
||||||
output ("templates" </> "new-issue.tpl") $(embedStringFile "templates/new-issue.tpl")
|
|
||||||
debug "git add issues.org"
|
|
||||||
|
|
||||||
initDocs :: IO ()
|
|
||||||
initDocs = do
|
|
||||||
echo "* wiki.org"
|
|
||||||
output "wiki.org" $(embedStringFile "templates/wiki.org")
|
|
||||||
debug "git add wiki.org"
|
|
||||||
|
|
||||||
initReview :: IO ()
|
|
||||||
initReview = do
|
|
||||||
let fic = "reviews" </> "write-contributing-yogsototh.org"
|
|
||||||
mktree "reviews"
|
|
||||||
putText $ format ("* "%fp) fic
|
|
||||||
output fic $(embedStringFile "templates/review.org")
|
|
||||||
debug "git add reviews"
|
|
||||||
|
|
25
src/GPM/Docs.hs
Normal file
25
src/GPM/Docs.hs
Normal file
|
@ -0,0 +1,25 @@
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-|
|
||||||
|
module : GPM.Docs
|
||||||
|
Description : GPM docs commands
|
||||||
|
License : Public Domain
|
||||||
|
Maintainer : yann.esposito@gmail.com
|
||||||
|
-}
|
||||||
|
module GPM.Docs
|
||||||
|
(init)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude
|
||||||
|
import Turtle
|
||||||
|
|
||||||
|
import Data.FileEmbed (embedStringFile)
|
||||||
|
|
||||||
|
import GPM.Helpers (debug)
|
||||||
|
|
||||||
|
init :: IO ()
|
||||||
|
init = do
|
||||||
|
echo "* wiki.org"
|
||||||
|
output "wiki.org" $(embedStringFile "templates/wiki.org")
|
||||||
|
debug "git add wiki.org"
|
39
src/GPM/Helpers.hs
Normal file
39
src/GPM/Helpers.hs
Normal file
|
@ -0,0 +1,39 @@
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-|
|
||||||
|
module : GPM.Helpers
|
||||||
|
Description : GPM helper functions
|
||||||
|
License : Public Domain
|
||||||
|
Maintainer : yann.esposito@gmail.com
|
||||||
|
-}
|
||||||
|
module GPM.Helpers
|
||||||
|
(debug,inGPM)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude hiding (stdout,fold,die)
|
||||||
|
import Turtle
|
||||||
|
|
||||||
|
import qualified Control.Foldl as Fold
|
||||||
|
|
||||||
|
debug :: Text -> IO ()
|
||||||
|
debug cmd = do
|
||||||
|
putText cmd
|
||||||
|
stdout $ inshell cmd empty
|
||||||
|
|
||||||
|
-- | 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)
|
39
src/GPM/Init.hs
Normal file
39
src/GPM/Init.hs
Normal file
|
@ -0,0 +1,39 @@
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
|
{-|
|
||||||
|
module : GPM.Init
|
||||||
|
Description : GPM init command
|
||||||
|
License : Public Domain
|
||||||
|
Maintainer : yann.esposito@gmail.com
|
||||||
|
-}
|
||||||
|
module GPM.Init
|
||||||
|
(init)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude
|
||||||
|
import Turtle
|
||||||
|
|
||||||
|
import GPM.Helpers (debug)
|
||||||
|
import qualified GPM.Docs as Docs
|
||||||
|
import qualified GPM.Issue as Issue
|
||||||
|
import qualified GPM.Review as Review
|
||||||
|
|
||||||
|
init :: IO ()
|
||||||
|
init = do
|
||||||
|
echo "# <GPM> -- Git Project Manager"
|
||||||
|
mkNewEmptyBranch "gpm"
|
||||||
|
Issue.init
|
||||||
|
Docs.init
|
||||||
|
Review.init
|
||||||
|
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
|
||||||
|
echo "cleanup the branch"
|
||||||
|
debug "git rm --cached -r ."
|
||||||
|
|
29
src/GPM/Issue.hs
Normal file
29
src/GPM/Issue.hs
Normal file
|
@ -0,0 +1,29 @@
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
|
{-|
|
||||||
|
module : GPM.Issue
|
||||||
|
Description : GPM new issue related command
|
||||||
|
License : Public Domain
|
||||||
|
Maintainer : yann.esposito@gmail.com
|
||||||
|
-}
|
||||||
|
module GPM.Issue
|
||||||
|
( init
|
||||||
|
, newIssue
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude hiding (die)
|
||||||
|
import Turtle
|
||||||
|
|
||||||
|
import Data.FileEmbed (embedStringFile)
|
||||||
|
|
||||||
|
newIssue :: IO ()
|
||||||
|
newIssue = die "TODO"
|
||||||
|
|
||||||
|
init :: IO ()
|
||||||
|
init = do
|
||||||
|
echo "* issue.org"
|
||||||
|
output "issues.org" $(embedStringFile "templates/issues.org")
|
||||||
|
|
|
@ -1,9 +1,26 @@
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module GPM.Review where
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
import Protolude hiding (stdout,die)
|
{-|
|
||||||
import Turtle
|
module : GPM.Review
|
||||||
|
Description : GPM review related commands
|
||||||
|
License : Public Domain
|
||||||
|
Maintainer : yann.esposito@gmail.com
|
||||||
|
-}
|
||||||
|
module GPM.Review
|
||||||
|
( init
|
||||||
|
, parseReviewCmd
|
||||||
|
, handleReview
|
||||||
|
, ReviewCommand(..)
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude hiding (die, (%))
|
||||||
|
import Turtle
|
||||||
|
|
||||||
|
import Data.FileEmbed (embedStringFile)
|
||||||
|
import GPM.Helpers (debug)
|
||||||
|
|
||||||
data ReviewCommand = ReviewStart (Maybe Text)
|
data ReviewCommand = ReviewStart (Maybe Text)
|
||||||
| ReviewStop (Maybe Text)
|
| ReviewStop (Maybe Text)
|
||||||
|
@ -13,6 +30,16 @@ data ReviewCommand = ReviewStart (Maybe Text)
|
||||||
| ReviewReject
|
| ReviewReject
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
||||||
|
-- | init gpm branch to handle reviews
|
||||||
|
init :: IO ()
|
||||||
|
init = do
|
||||||
|
let fic = "reviews" </> "write-contributing-yogsototh.org"
|
||||||
|
mktree "reviews"
|
||||||
|
putText $ format ("* "%fp) fic
|
||||||
|
output fic $(embedStringFile "templates/review.org")
|
||||||
|
debug "git add reviews"
|
||||||
|
|
||||||
|
|
||||||
parseReviewCmd :: Parser ReviewCommand
|
parseReviewCmd :: Parser ReviewCommand
|
||||||
parseReviewCmd =
|
parseReviewCmd =
|
||||||
subcommand "accept" "Accept the merge" (pure ReviewAccept)
|
subcommand "accept" "Accept the merge" (pure ReviewAccept)
|
||||||
|
|
Loading…
Reference in a new issue