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
|
||||
--
|
||||
-- hash: c6d39ec4e6cb0558da69c75830e9471b116c0dfabc6cdbaaefa819cea92298b1
|
||||
-- hash: f13ce9cfb72ed8d7e916b9e6cf99111cfd7fbe4bc5083fb018698023360414db
|
||||
|
||||
name: gpm
|
||||
version: 0.1.0.0
|
||||
|
@ -22,6 +22,10 @@ extra-source-files:
|
|||
library
|
||||
exposed-modules:
|
||||
GPM
|
||||
GPM.Docs
|
||||
GPM.Helpers
|
||||
GPM.Init
|
||||
GPM.Issue
|
||||
GPM.Review
|
||||
other-modules:
|
||||
Paths_gpm
|
||||
|
@ -33,6 +37,7 @@ library
|
|||
base >=4.8 && <5
|
||||
, file-embed
|
||||
, foldl
|
||||
, mustache
|
||||
, protolude
|
||||
, turtle
|
||||
default-language: Haskell2010
|
||||
|
@ -50,6 +55,7 @@ executable gpm
|
|||
, file-embed
|
||||
, foldl
|
||||
, gpm
|
||||
, mustache
|
||||
, protolude
|
||||
, turtle
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -28,6 +28,7 @@ dependencies:
|
|||
- turtle
|
||||
- file-embed
|
||||
- foldl
|
||||
- mustache
|
||||
library:
|
||||
source-dirs: src
|
||||
executables:
|
||||
|
|
85
src/GPM.hs
85
src/GPM.hs
|
@ -1,29 +1,34 @@
|
|||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-|
|
||||
module : GPM
|
||||
Description : GPM command line function
|
||||
License : Public Domain
|
||||
Maintainer : yann.esposito@gmail.com
|
||||
-}
|
||||
module GPM
|
||||
where
|
||||
|
||||
import Data.FileEmbed (embedStringFile)
|
||||
import Protolude hiding (die, stdout, (%),fold)
|
||||
import Protolude hiding (stdout)
|
||||
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 = do
|
||||
subcmd <- options "Git Project Manager" parser
|
||||
case subcmd of
|
||||
Init -> init
|
||||
NewIssue -> inGPM newIssue
|
||||
Review reviewCmd -> inGPM (handleReview reviewCmd)
|
||||
Init -> Init.init
|
||||
NewIssue -> inGPM Issue.newIssue
|
||||
Review reviewCmd -> inGPM (Review.handleReview reviewCmd)
|
||||
|
||||
data Command = Init
|
||||
| NewIssue
|
||||
| Review ReviewCommand
|
||||
| Review Review.ReviewCommand
|
||||
deriving (Eq)
|
||||
|
||||
parser :: Parser Command
|
||||
|
@ -31,65 +36,9 @@ parser = subcommand "init" "Initialize gpm" (pure Init)
|
|||
<|> subcommand "new-issue" "Create a new Issue" (pure NewIssue)
|
||||
<|> Review <$> subcommand "review"
|
||||
"Review (use current branch by default)"
|
||||
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 ."
|
||||
Review.parseReviewCmd
|
||||
|
||||
debug :: Text -> IO ()
|
||||
debug cmd = do
|
||||
putText cmd
|
||||
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 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)
|
||||
| ReviewStop (Maybe Text)
|
||||
|
@ -13,6 +30,16 @@ data ReviewCommand = ReviewStart (Maybe Text)
|
|||
| ReviewReject
|
||||
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 =
|
||||
subcommand "accept" "Accept the merge" (pure ReviewAccept)
|
||||
|
|
Loading…
Reference in a new issue