naive review handling
This commit is contained in:
parent
82dad71eca
commit
ce3c01c7cd
3 changed files with 74 additions and 16 deletions
|
@ -2,7 +2,7 @@
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: ab6ea5ad975f268ebb05939f453aeb3f190183a3472aaa84b76871d4f1b09e05
|
||||
-- hash: a6d129913c89afe00223987f8c28215c0300bbe090e95b121fe66e3c4005a9b1
|
||||
|
||||
name: gpm
|
||||
version: 0.1.0.0
|
||||
|
@ -35,13 +35,13 @@ library
|
|||
ghc-options: -O2 -Werror -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances
|
||||
build-depends:
|
||||
base >=4.8 && <5
|
||||
, directory
|
||||
, file-embed
|
||||
, foldl
|
||||
, mustache
|
||||
, protolude
|
||||
, text
|
||||
, turtle
|
||||
, directory
|
||||
default-language: Haskell2010
|
||||
|
||||
executable gpm
|
||||
|
@ -54,6 +54,7 @@ executable gpm
|
|||
ghc-options: -O2 -Werror -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances -threaded -rtsopts -with-rtsopts=-N -optP-Wno-nonportable-include-path
|
||||
build-depends:
|
||||
base >=4.8 && <5
|
||||
, directory
|
||||
, file-embed
|
||||
, foldl
|
||||
, gpm
|
||||
|
|
|
@ -24,12 +24,13 @@ ghc-options:
|
|||
- -Wnoncanonical-monad-instances
|
||||
dependencies:
|
||||
- base >=4.8 && <5
|
||||
- protolude
|
||||
- turtle
|
||||
- directory
|
||||
- file-embed
|
||||
- foldl
|
||||
- mustache
|
||||
- protolude
|
||||
- text
|
||||
- turtle
|
||||
library:
|
||||
source-dirs: src
|
||||
executables:
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE ApplicativeDo #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
@ -21,11 +22,11 @@ import Protolude hiding (ask, die, (%))
|
|||
import Turtle
|
||||
|
||||
import Data.FileEmbed (embedStringFile)
|
||||
import GPM.Helpers (getGPMCacheDir, debug_)
|
||||
import GPM.Helpers (getGPMCacheDir, debug_, getGitUser)
|
||||
import Text.Mustache
|
||||
|
||||
data ReviewCommand = ReviewStart (Maybe Text)
|
||||
| ReviewStop (Maybe Text)
|
||||
data ReviewCommand = ReviewStart ReviewOptions
|
||||
| ReviewCommit
|
||||
| ReviewAccept
|
||||
| ReviewFeedback
|
||||
| ReviewQuestion
|
||||
|
@ -42,20 +43,71 @@ init = do
|
|||
debug_ "git add reviews"
|
||||
|
||||
|
||||
data ReviewOptions = ReviewOptions
|
||||
{ interactive :: Bool
|
||||
, newReview :: NewReview
|
||||
} deriving (Eq)
|
||||
|
||||
parseReviewOptions :: Parser ReviewOptions
|
||||
parseReviewOptions = ReviewOptions
|
||||
<$> switch "interactive" 'i' "Interactive mode"
|
||||
<*> parseNewReview
|
||||
|
||||
|
||||
parseNewReview :: Parser NewReview
|
||||
parseNewReview = do
|
||||
nrStatus <- optional $ optText "status" 's' "The status of the review (TODO, QUESTION, ...)"
|
||||
nrTitle <- optional $ optText "title" 't' "The status title"
|
||||
nrUser <- optional $ optText "creator" 'c' "The user that created the review"
|
||||
nrBranch <- optional $ optText "branch" 'b' "The branch related to the review"
|
||||
nrDescription <- optional $ optText "descr" 'd' "Long review description"
|
||||
pure NewReview { status = fromMaybe "TODO" nrStatus
|
||||
, title = fromMaybe "Review Title" nrTitle
|
||||
, user = nrUser
|
||||
, branch = nrBranch
|
||||
, reviewer = nrUser
|
||||
, description = nrDescription
|
||||
}
|
||||
|
||||
parseReviewCmd :: Parser ReviewCommand
|
||||
parseReviewCmd =
|
||||
subcommand "accept" "Accept the merge" (pure ReviewAccept)
|
||||
<|> subcommand "feedback" "Provide a feedback" (pure ReviewFeedback)
|
||||
<|> subcommand "question" "Ask a question" (pure ReviewQuestion)
|
||||
<|> subcommand "reject" "Reject the merge" (pure ReviewReject)
|
||||
<|> subcommand "start" "Create a new review" (ReviewStart <$> parseReviewOptions)
|
||||
<|> subcommand "end" "End a review" (pure ReviewCommit)
|
||||
|
||||
|
||||
gatherNewReviewInfos :: NewReview -> Text -> IO NewReview
|
||||
gatherNewReviewInfos iss br = do
|
||||
user <- if isNothing (user iss)
|
||||
then getGitUser
|
||||
else return (user iss)
|
||||
branch <- if isNothing (branch iss)
|
||||
then return (Just br)
|
||||
else return (branch iss)
|
||||
return $ iss { user = user
|
||||
, branch = branch }
|
||||
|
||||
handleReview :: ReviewCommand -> Text -> IO ()
|
||||
handleReview (ReviewStart _br) _ = die "TODO"
|
||||
handleReview (ReviewStop _br ) _ = die "TODO"
|
||||
handleReview ReviewAccept _ = die "TODO"
|
||||
handleReview ReviewFeedback _ = die "TODO"
|
||||
handleReview ReviewQuestion _ = die "TODO"
|
||||
handleReview ReviewReject _ = die "TODO"
|
||||
handleReview (ReviewStart opts) br = do
|
||||
newReviewTmp <- gatherNewReviewInfos (newReview opts) br
|
||||
newReview <- if interactive opts
|
||||
then interactiveNewReview newReviewTmp
|
||||
else return newReviewTmp
|
||||
createTmpNewReview newReview
|
||||
handleReview ReviewCommit _ = validTmpNewReview
|
||||
handleReview ReviewAccept _ = die "TODO"
|
||||
handleReview ReviewFeedback _ = die "TODO"
|
||||
handleReview ReviewQuestion _ = die "TODO"
|
||||
handleReview ReviewReject _ = die "TODO"
|
||||
|
||||
validTmpNewReview :: IO ()
|
||||
validTmpNewReview = do
|
||||
tmpReviewFile <- getTmpReviewFile
|
||||
tmpIssue <- readFile (toS (format fp tmpReviewFile))
|
||||
appendFile "issues.org" ("\n\n" <> tmpIssue)
|
||||
|
||||
data NewReview =
|
||||
NewReview { status :: Text
|
||||
|
@ -64,7 +116,7 @@ data NewReview =
|
|||
, branch :: Maybe Text
|
||||
, reviewer :: Maybe User
|
||||
, description :: Maybe Text
|
||||
}
|
||||
} deriving (Eq)
|
||||
|
||||
type User = Text
|
||||
|
||||
|
@ -78,6 +130,11 @@ instance ToMustache NewReview where
|
|||
, "description" ~> description
|
||||
]
|
||||
|
||||
getTmpReviewFile :: IO Turtle.FilePath
|
||||
getTmpReviewFile = do
|
||||
cacheDir <- getGPMCacheDir
|
||||
return $ cacheDir </> "review-feedback.org"
|
||||
|
||||
createTmpNewReview :: NewReview -> IO ()
|
||||
createTmpNewReview nr = do
|
||||
ecompiled <- automaticCompile ["./templates"] "new-review.org"
|
||||
|
@ -86,8 +143,7 @@ createTmpNewReview nr = do
|
|||
print pe
|
||||
die "Parse ERROR, check your template ./templates/new-review.org"
|
||||
Right compiled -> do
|
||||
cacheDir <- getGPMCacheDir
|
||||
let reviewName = cacheDir </> "review-feedback.org"
|
||||
reviewName <- getTmpReviewFile
|
||||
writeFile (toS (format fp reviewName)) (substitute compiled nr)
|
||||
|
||||
interactiveNewReview :: NewReview -> IO NewReview
|
||||
|
|
Loading…
Reference in a new issue