diff --git a/gpm.cabal b/gpm.cabal index a99648f..f25b890 100644 --- a/gpm.cabal +++ b/gpm.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 04bfdb9ffa855881f6cd6cc09bf3b494a2107ded6cc33c41699546a12526099e +-- hash: 5bfe1aa5fe45c81553fa282f889cbe95ef3bbfd9d254f8a67458609998b15f9a name: gpm version: 0.1.0.0 @@ -45,6 +45,10 @@ library , protolude , text , turtle + , unix + , wai + , wai-app-static + , warp default-language: Haskell2010 executable gpm @@ -66,4 +70,8 @@ executable gpm , protolude , text , turtle + , unix + , wai + , wai-app-static + , warp default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 2990b69..e21a502 100644 --- a/package.yaml +++ b/package.yaml @@ -23,8 +23,8 @@ ghc-options: - -Wredundant-constraints - -Wnoncanonical-monad-instances dependencies: -- base >=4.8 && <5 - ansi-terminal +- base >=4.8 && <5 - directory - file-embed - foldl @@ -32,6 +32,10 @@ dependencies: - protolude - text - turtle +- unix +- wai +- wai-app-static +- warp library: source-dirs: src executables: diff --git a/playground/gpm-test.sh b/playground/gpm-test.sh index cf3cf6c..aa0eeab 100755 --- a/playground/gpm-test.sh +++ b/playground/gpm-test.sh @@ -1,18 +1,57 @@ #!/usr/bin/env zsh -[[ -d testproj ]] && rm -rf testproj -mkdir testproj -pushd testproj +set -x + +title(){ + set +x + echo + print -- "----------------------------------------" + print -- " $*" + print -- "----------------------------------------" + echo + set -x +} + +prjname="testproj" +testproj="/tmp/$prjname" +testproj2="/tmp/testproj2" +mkdir -p $testproj +pushd $testproj + +title "CLEANING UP" +[[ -d $testproj ]] && rm -rf $testproj +[[ -d $testproj2 ]] && rm -rf $testproj2 +title "CREATE PROJECT $testproj" +mkdir $testproj +pushd $testproj echo "README 1" > README git init . git add README git commit -m "initial commit" +title "gpm init" gpm init +title "gpm new-issue" gpm new-issue -t "issue-1" -p "A" +title "HOOKS" git co gpm cp hooks/prepare-commit-msg{.sample,} git add hooks git commit -m "updated the prepare-commit-msg git hook" git co master +title "gpm hooks sync" gpm hooks sync +title "gpm serve start" +gpm serve start popd +mkdir $testproj2 +pushd $testproj2 +git clone http://localhost:3000/${prjname}.git $testproj2 +gpm serve stop +popd + +popd + +echo +echo "--------" +echo "$testproj" +echo "$testproj2" diff --git a/src/GPM.hs b/src/GPM.hs index 184e54c..f213f35 100755 --- a/src/GPM.hs +++ b/src/GPM.hs @@ -27,7 +27,7 @@ gpm = do Init -> Init.init NewIssue issueOpt -> inGPM (Issue.handleNewIssue issueOpt) Review reviewCmd -> inGPM (Review.handleReview reviewCmd) - Serve serveCmd -> inGPM (Serve.handleServe serveCmd) + Serve serveCmd -> Serve.handleServe serveCmd Hooks hooksCmd -> inGPM (Hooks.handleHooks hooksCmd) data Command = Init diff --git a/src/GPM/Serve.hs b/src/GPM/Serve.hs index 698ca8b..723517e 100644 --- a/src/GPM/Serve.hs +++ b/src/GPM/Serve.hs @@ -13,17 +13,28 @@ module GPM.Serve ) where -import Protolude hiding (die, (%)) +-- | Generic Import +import Protolude hiding (die, stdout, (%), (<.>)) import Turtle -import GPM.Helpers (debug, debug_, getGPMDataDir, inDir, green) +-- | Local Imports +import GPM.Helpers (debug, debug_, getGPMDataDir, + green, inDir, inGPM) +-- | External Lib Imports +import qualified Data.Text as Text +import qualified Network.Wai.Application.Static as WaiStatic +import qualified Network.Wai.Handler.Warp as Warp +import qualified System.Posix.Process as Process + +-- | Retrieve a public dir to serve git repositories getPublicDir :: IO Turtle.FilePath getPublicDir = do gpmDataDir <- getGPMDataDir let publicdir = gpmDataDir "public" return publicdir +-- | Retrieve the git project root directory getProjectRoot :: IO Turtle.FilePath getProjectRoot = do mReporoot <- debug "git rev-parse --show-toplevel" @@ -31,12 +42,13 @@ getProjectRoot = do Nothing -> die "You don't appear to be in a git repository." Just reporoot -> return (fromString (toS reporoot)) +-- | Retrieve the git public directory for the project getPublicPrjDir :: IO Turtle.FilePath getPublicPrjDir = do publicdir <- getPublicDir reporoot <- getProjectRoot let projectName = basename reporoot - return (publicdir projectName) + return (publicdir (projectName <.> "git")) -- | init gpm branch to handle reviews init :: IO () @@ -77,14 +89,14 @@ parseServeCommand = <|> subcommand "update" "Update the served git repository" (pure ServeUpdate) <|> subcommand "path" "Show the path of the bare repository" (pure ServeUpdate) -handleServe :: ServeCommand -> Text -> IO () -handleServe ServeStart _ = handleServeStart -handleServe ServeStop _ = handleServeStop -handleServe ServeUpdate _ = handleUpdate -handleServe ProjectDir _ = handleProjectDir +handleServe :: ServeCommand -> IO () +handleServe ServeStart = handleServeStart +handleServe ServeStop = handleServeStop +handleServe ServeUpdate = inGPM handleUpdate +handleServe ProjectDir = handleProjectDir -handleUpdate :: IO () -handleUpdate = do +handleUpdate :: Text -> IO () +handleUpdate _ = do pubPrjDir <- getPublicPrjDir inDir pubPrjDir $ do pwd >>= putText . format fp @@ -96,7 +108,7 @@ handleServeStart = do inDir pubDir $ do pwd >>= putText . format fp debug_ "git instaweb --http=webrick start" - -- TODO: Do not forget to also git serve + dirServe handleServeStop :: IO () handleServeStop = do @@ -104,6 +116,25 @@ handleServeStop = do inDir pubDir $ do pwd >>= putText . format fp debug_ "git instaweb --http=webrick stop" + dirStopServe handleProjectDir :: IO () handleProjectDir = getPublicDir >>= putText . format fp + +dirServe :: IO () +dirServe = do + processId <- Process.forkProcess $ Warp.run 3000 (WaiStatic.staticApp (WaiStatic.defaultWebAppSettings ".")) + gpmDataDir <- getGPMDataDir + inDir gpmDataDir $ do + mktree "procs" + writeTextFile ("procs" "gitServePID") (show processId) + +dirStopServe :: IO () +dirStopServe = do + gpmDataDir <- getGPMDataDir + inDir gpmDataDir $ do + pidtxt <- readTextFile ("procs" "gitServePID") + if Text.null pidtxt + then putErrText "The git server doesn't appear to be running" + else debug_ ("kill " <> pidtxt) +