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
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: ab6ea5ad975f268ebb05939f453aeb3f190183a3472aaa84b76871d4f1b09e05
|
-- hash: a6d129913c89afe00223987f8c28215c0300bbe090e95b121fe66e3c4005a9b1
|
||||||
|
|
||||||
name: gpm
|
name: gpm
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
|
@ -35,13 +35,13 @@ library
|
||||||
ghc-options: -O2 -Werror -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances
|
ghc-options: -O2 -Werror -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.8 && <5
|
base >=4.8 && <5
|
||||||
|
, directory
|
||||||
, file-embed
|
, file-embed
|
||||||
, foldl
|
, foldl
|
||||||
, mustache
|
, mustache
|
||||||
, protolude
|
, protolude
|
||||||
, text
|
, text
|
||||||
, turtle
|
, turtle
|
||||||
, directory
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable gpm
|
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
|
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:
|
build-depends:
|
||||||
base >=4.8 && <5
|
base >=4.8 && <5
|
||||||
|
, directory
|
||||||
, file-embed
|
, file-embed
|
||||||
, foldl
|
, foldl
|
||||||
, gpm
|
, gpm
|
||||||
|
|
|
@ -24,12 +24,13 @@ ghc-options:
|
||||||
- -Wnoncanonical-monad-instances
|
- -Wnoncanonical-monad-instances
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >=4.8 && <5
|
- base >=4.8 && <5
|
||||||
- protolude
|
- directory
|
||||||
- turtle
|
|
||||||
- file-embed
|
- file-embed
|
||||||
- foldl
|
- foldl
|
||||||
- mustache
|
- mustache
|
||||||
|
- protolude
|
||||||
- text
|
- text
|
||||||
|
- turtle
|
||||||
library:
|
library:
|
||||||
source-dirs: src
|
source-dirs: src
|
||||||
executables:
|
executables:
|
||||||
|
|
|
@ -1,3 +1,4 @@
|
||||||
|
{-# LANGUAGE ApplicativeDo #-}
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
@ -21,11 +22,11 @@ import Protolude hiding (ask, die, (%))
|
||||||
import Turtle
|
import Turtle
|
||||||
|
|
||||||
import Data.FileEmbed (embedStringFile)
|
import Data.FileEmbed (embedStringFile)
|
||||||
import GPM.Helpers (getGPMCacheDir, debug_)
|
import GPM.Helpers (getGPMCacheDir, debug_, getGitUser)
|
||||||
import Text.Mustache
|
import Text.Mustache
|
||||||
|
|
||||||
data ReviewCommand = ReviewStart (Maybe Text)
|
data ReviewCommand = ReviewStart ReviewOptions
|
||||||
| ReviewStop (Maybe Text)
|
| ReviewCommit
|
||||||
| ReviewAccept
|
| ReviewAccept
|
||||||
| ReviewFeedback
|
| ReviewFeedback
|
||||||
| ReviewQuestion
|
| ReviewQuestion
|
||||||
|
@ -42,20 +43,71 @@ init = do
|
||||||
debug_ "git add reviews"
|
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 :: Parser ReviewCommand
|
||||||
parseReviewCmd =
|
parseReviewCmd =
|
||||||
subcommand "accept" "Accept the merge" (pure ReviewAccept)
|
subcommand "accept" "Accept the merge" (pure ReviewAccept)
|
||||||
<|> subcommand "feedback" "Provide a feedback" (pure ReviewFeedback)
|
<|> subcommand "feedback" "Provide a feedback" (pure ReviewFeedback)
|
||||||
<|> subcommand "question" "Ask a question" (pure ReviewQuestion)
|
<|> subcommand "question" "Ask a question" (pure ReviewQuestion)
|
||||||
<|> subcommand "reject" "Reject the merge" (pure ReviewReject)
|
<|> 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 :: ReviewCommand -> Text -> IO ()
|
||||||
handleReview (ReviewStart _br) _ = die "TODO"
|
handleReview (ReviewStart opts) br = do
|
||||||
handleReview (ReviewStop _br ) _ = die "TODO"
|
newReviewTmp <- gatherNewReviewInfos (newReview opts) br
|
||||||
handleReview ReviewAccept _ = die "TODO"
|
newReview <- if interactive opts
|
||||||
handleReview ReviewFeedback _ = die "TODO"
|
then interactiveNewReview newReviewTmp
|
||||||
handleReview ReviewQuestion _ = die "TODO"
|
else return newReviewTmp
|
||||||
handleReview ReviewReject _ = die "TODO"
|
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 =
|
data NewReview =
|
||||||
NewReview { status :: Text
|
NewReview { status :: Text
|
||||||
|
@ -64,7 +116,7 @@ data NewReview =
|
||||||
, branch :: Maybe Text
|
, branch :: Maybe Text
|
||||||
, reviewer :: Maybe User
|
, reviewer :: Maybe User
|
||||||
, description :: Maybe Text
|
, description :: Maybe Text
|
||||||
}
|
} deriving (Eq)
|
||||||
|
|
||||||
type User = Text
|
type User = Text
|
||||||
|
|
||||||
|
@ -78,6 +130,11 @@ instance ToMustache NewReview where
|
||||||
, "description" ~> description
|
, "description" ~> description
|
||||||
]
|
]
|
||||||
|
|
||||||
|
getTmpReviewFile :: IO Turtle.FilePath
|
||||||
|
getTmpReviewFile = do
|
||||||
|
cacheDir <- getGPMCacheDir
|
||||||
|
return $ cacheDir </> "review-feedback.org"
|
||||||
|
|
||||||
createTmpNewReview :: NewReview -> IO ()
|
createTmpNewReview :: NewReview -> IO ()
|
||||||
createTmpNewReview nr = do
|
createTmpNewReview nr = do
|
||||||
ecompiled <- automaticCompile ["./templates"] "new-review.org"
|
ecompiled <- automaticCompile ["./templates"] "new-review.org"
|
||||||
|
@ -86,8 +143,7 @@ createTmpNewReview nr = do
|
||||||
print pe
|
print pe
|
||||||
die "Parse ERROR, check your template ./templates/new-review.org"
|
die "Parse ERROR, check your template ./templates/new-review.org"
|
||||||
Right compiled -> do
|
Right compiled -> do
|
||||||
cacheDir <- getGPMCacheDir
|
reviewName <- getTmpReviewFile
|
||||||
let reviewName = cacheDir </> "review-feedback.org"
|
|
||||||
writeFile (toS (format fp reviewName)) (substitute compiled nr)
|
writeFile (toS (format fp reviewName)) (substitute compiled nr)
|
||||||
|
|
||||||
interactiveNewReview :: NewReview -> IO NewReview
|
interactiveNewReview :: NewReview -> IO NewReview
|
||||||
|
|
Loading…
Reference in a new issue