diff --git a/gpm.cabal b/gpm.cabal index b48b312..4588977 100644 --- a/gpm.cabal +++ b/gpm.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: a6d129913c89afe00223987f8c28215c0300bbe090e95b121fe66e3c4005a9b1 +-- hash: 1cf72e2df7c9707db3de5badabd66d0a2123d9260d2eff8bfa4e32ef4c449cfd name: gpm version: 0.1.0.0 @@ -27,6 +27,7 @@ library GPM.Init GPM.Issue GPM.Review + GPM.Serve other-modules: Paths_gpm hs-source-dirs: diff --git a/src/GPM.hs b/src/GPM.hs index 6187aa2..12406e4 100755 --- a/src/GPM.hs +++ b/src/GPM.hs @@ -17,6 +17,7 @@ import GPM.Helpers (inGPM) import qualified GPM.Init as Init import qualified GPM.Issue as Issue import qualified GPM.Review as Review +import qualified GPM.Serve as Serve gpm :: IO () gpm = do @@ -25,10 +26,12 @@ gpm = do Init -> Init.init NewIssue issueOpt -> inGPM (Issue.handleNewIssue issueOpt) Review reviewCmd -> inGPM (Review.handleReview reviewCmd) + Serve serveCmd -> inGPM (Serve.handleServe serveCmd) data Command = Init | NewIssue Issue.IssueOptions | Review Review.ReviewCommand + | Serve Serve.ServeCommand parser :: Parser Command parser = subcommand "init" "Initialize gpm" (pure Init) @@ -38,6 +41,9 @@ parser = subcommand "init" "Initialize gpm" (pure Init) <|> Review <$> subcommand "review" "Review (use current branch by default)" Review.parseReviewCmd + <|> Serve <$> subcommand "serve" + "Serve the git to the web" + Serve.parseServeCommand debug :: Text -> IO () debug cmd = do diff --git a/src/GPM/Helpers.hs b/src/GPM/Helpers.hs index 35dd376..21fada7 100644 --- a/src/GPM/Helpers.hs +++ b/src/GPM/Helpers.hs @@ -13,6 +13,7 @@ module GPM.Helpers , getGPMDataDir , getGitUser , inGPM + , inDir ) where @@ -59,3 +60,12 @@ inGPM = bracket safeChangeBranch safeReturnBranch getGPMDataDir :: IO Turtle.FilePath getGPMDataDir = fromString <$> Directory.getXdgDirectory Directory.XdgData "gpm" +-- | Perform some actions in some directory. +-- Take care of returning the the previous directory after the action are finished +inDir :: MonadIO m => Turtle.FilePath -> m a -> m a +inDir workDir action = do + currPwd <- pwd + cd workDir + res <- action + cd currPwd + return res diff --git a/src/GPM/Init.hs b/src/GPM/Init.hs index 564cde6..4b764b6 100644 --- a/src/GPM/Init.hs +++ b/src/GPM/Init.hs @@ -20,6 +20,7 @@ import qualified GPM.Docs as Docs import GPM.Helpers (debug_) import qualified GPM.Issue as Issue import qualified GPM.Review as Review +import qualified GPM.Serve as Serve -- | Init a repository with a new empty branch named @gpm@ init :: IO () @@ -29,6 +30,7 @@ init = do Issue.init Docs.init Review.init + Serve.init debug_ "git commit -m 'gpm initialized'" debug_ "git checkout master" diff --git a/src/GPM/Serve.hs b/src/GPM/Serve.hs index 6a65999..f06bf44 100644 --- a/src/GPM/Serve.hs +++ b/src/GPM/Serve.hs @@ -7,13 +7,16 @@ Maintainer : yann.esposito@gmail.com -} module GPM.Serve ( init + , handleServe + , parseServeCommand + , ServeCommand ) where import Protolude hiding (ask, die, (%),stdout) import Turtle -import GPM.Helpers (getGPMDataDir, debug, debug_) +import GPM.Helpers (getGPMDataDir, debug, debug_, inDir) getPublicDir :: IO Turtle.FilePath getPublicDir = do @@ -21,23 +24,19 @@ getPublicDir = do let publicdir = gpmDataDir "public" return publicdir +getProjectRoot :: IO Turtle.FilePath +getProjectRoot = do + mReporoot <- debug "git rev-parse --show-toplevel" + case mReporoot of + Nothing -> die "You don't appear to be in a git repository." + Just reporoot -> return (fromString (toS reporoot)) + 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 + reporoot <- getProjectRoot + let projectName = basename reporoot + return (publicdir projectName) -- | init gpm branch to handle reviews @@ -45,23 +44,54 @@ init :: IO () init = do echo "* server init" publicdir <- getPublicDir + putText (format ("create dir: "%fp) publicdir) mktree publicdir - debug_ "git init ." - output (publicdir ".git" "description") "Main repositories" + inDir publicdir $ do + debug_ "git init ." + let descriptionFile = publicdir ".git" "description" + output descriptionFile "Main repositories" + repoRoot <- getProjectRoot publicProjectDir <- getPublicPrjDir + debug_ (format ("git clone --bare "%fp%" "%fp) + repoRoot + publicProjectDir) inDir publicProjectDir $ do mv ("hooks" "post-update.sample") ("hooks" "post-update") _ <- chmod executable ("hooks" "post-update") debug_ "git update-server-info" +-- | Serve command + +data ServeCommand = ServeStart + | ServeStop + | ServeUpdate + deriving (Eq) + +parseServeCommand :: Parser ServeCommand +parseServeCommand = + subcommand "start" "Start to serve all gpm tracked repositories" (pure ServeStart) + <|> subcommand "stop" "Stop to serve all gpm tracked repositories" (pure ServeStop) + <|> subcommand "update" "Update the served git repository" (pure ServeUpdate) + +handleServe :: ServeCommand -> Text -> IO () +handleServe ServeStart _ = handleServeStart +handleServe ServeStop _ = handleServeStop +handleServe ServeUpdate _ = handleUpdate + handleUpdate :: IO () handleUpdate = do pubPrjDir <- getPublicPrjDir inDir pubPrjDir $ debug_ "git pull" -handleServe :: IO () -handleServe = do +handleServeStart :: IO () +handleServeStart = do pubDir <- getPublicDir inDir pubDir $ - debug_ "git instaweb --http=webrick" + debug_ "git instaweb --http=webrick start" + +handleServeStop :: IO () +handleServeStop = do + pubDir <- getPublicDir + inDir pubDir $ + debug_ "git instaweb --http=webrick stop"