diff --git a/src/GPM/Helpers.hs b/src/GPM/Helpers.hs index ad0cf3b..35dd376 100644 --- a/src/GPM/Helpers.hs +++ b/src/GPM/Helpers.hs @@ -10,7 +10,7 @@ module GPM.Helpers ( debug , debug_ , getCurrentGitBranch - , getGPMCacheDir + , getGPMDataDir , getGitUser , inGPM ) @@ -56,6 +56,6 @@ inGPM = bracket safeChangeBranch safeReturnBranch debug_ "git stash pop" -- | Retrieve the cache directory to save temporary files in gpm -getGPMCacheDir :: IO Turtle.FilePath -getGPMCacheDir = fromString <$> Directory.getXdgDirectory Directory.XdgCache "gpm" +getGPMDataDir :: IO Turtle.FilePath +getGPMDataDir = fromString <$> Directory.getXdgDirectory Directory.XdgData "gpm" diff --git a/src/GPM/Review.hs b/src/GPM/Review.hs index 1dc3df0..84c1c25 100644 --- a/src/GPM/Review.hs +++ b/src/GPM/Review.hs @@ -22,7 +22,7 @@ import Protolude hiding (ask, die, (%),stdout) import Turtle import Data.FileEmbed (embedStringFile) -import GPM.Helpers (getGPMCacheDir, debug_, getGitUser) +import GPM.Helpers (getGPMDataDir, debug_, getGitUser) import Text.Mustache import qualified Data.Text as Text import qualified Data.Char as Char @@ -52,11 +52,31 @@ init = do debug_ "git add templates" +-- | Command Line Options data ReviewOptions = ReviewOptions { interactive :: Bool , newReview :: NewReview } deriving (Eq) +data NewReview = + NewReview { status :: Text + , title :: Text + , user :: Maybe User + , branch :: Maybe Text + , description :: Maybe Text + } deriving (Eq) + +type User = Text + +instance ToMustache NewReview where + toMustache NewReview{..} = object + [ "status" ~> status + , "title" ~> title + , "user" ~> user + , "branch" ~> branch + , "description" ~> description + ] + parseFullReviewOptions :: Parser ReviewOptions parseFullReviewOptions = ReviewOptions @@ -194,30 +214,11 @@ validTmpNewReview br = do debug_ $ "git add " <> toS (format fp dstReview) debug_ $ "git commit -m \"review for " <> br <> "\"" -data NewReview = - NewReview { status :: Text - , title :: Text - , user :: Maybe User - , branch :: Maybe Text - , description :: Maybe Text - } deriving (Eq) - -type User = Text - -instance ToMustache NewReview where - toMustache NewReview{..} = object - [ "status" ~> status - , "title" ~> title - , "user" ~> user - , "branch" ~> branch - , "description" ~> description - ] - getTmpReviewFile :: Text -> IO Turtle.FilePath getTmpReviewFile br = do - cacheDir <- getGPMCacheDir + gpmDataDir <- getGPMDataDir let reviewFilename = "review-" <> protectStr br <> ".org" - return $ cacheDir fromString (toS reviewFilename) + return $ gpmDataDir fromString (toS reviewFilename) createTmpNewReview :: NewReview -> IO () createTmpNewReview nr = do diff --git a/src/GPM/Serve.hs b/src/GPM/Serve.hs new file mode 100644 index 0000000..6a65999 --- /dev/null +++ b/src/GPM/Serve.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-| +module : GPM.Serve +Description : GPM review related commands +License : Public Domain +Maintainer : yann.esposito@gmail.com +-} +module GPM.Serve + ( init + ) +where + +import Protolude hiding (ask, die, (%),stdout) +import Turtle + +import GPM.Helpers (getGPMDataDir, debug, debug_) + +getPublicDir :: IO Turtle.FilePath +getPublicDir = do + gpmDataDir <- getGPMDataDir + let publicdir = gpmDataDir "public" + return publicdir + +getPublicPrjDir :: IO Turtle.FilePath +getPublicPrjDir = do + publicdir <- getPublicDir + mReporoot <- debug "git rev-parse --show-toplevel" + case mReporoot of + Just reporoot -> do + let projectName = dirname (fromString (toS reporoot)) + return (publicdir projectName) + Nothing -> die "You don't appear to be in a git repository." + +inDir :: MonadIO m => Turtle.FilePath -> m a -> m a +inDir workDir action = do + currPwd <- pwd + cd workDir + res <- action + cd currPwd + return res + + +-- | init gpm branch to handle reviews +init :: IO () +init = do + echo "* server init" + publicdir <- getPublicDir + mktree publicdir + debug_ "git init ." + output (publicdir ".git" "description") "Main repositories" + publicProjectDir <- getPublicPrjDir + inDir publicProjectDir $ do + mv ("hooks" "post-update.sample") ("hooks" "post-update") + _ <- chmod executable ("hooks" "post-update") + debug_ "git update-server-info" + +handleUpdate :: IO () +handleUpdate = do + pubPrjDir <- getPublicPrjDir + inDir pubPrjDir $ + debug_ "git pull" + +handleServe :: IO () +handleServe = do + pubDir <- getPublicDir + inDir pubDir $ + debug_ "git instaweb --http=webrick"