serve basics
This commit is contained in:
parent
857324468f
commit
10b29065d2
5 changed files with 70 additions and 21 deletions
|
@ -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:
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
||||
|
|
|
@ -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))
|
||||
reporoot <- getProjectRoot
|
||||
let projectName = basename 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
|
||||
|
@ -45,23 +44,54 @@ init :: IO ()
|
|||
init = do
|
||||
echo "* server init"
|
||||
publicdir <- getPublicDir
|
||||
putText (format ("create dir: "%fp) publicdir)
|
||||
mktree publicdir
|
||||
inDir publicdir $ do
|
||||
debug_ "git init ."
|
||||
output (publicdir </> ".git" </> "description") "Main repositories"
|
||||
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"
|
||||
|
|
Loading…
Reference in a new issue