use git daemon and handle init from a gpm supported repo clone

gpm.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 5bfe1aa5fe45c81553fa282f889cbe95ef3bbfd9d254f8a67458609998b15f9a
+-- hash: d9338d9561ff06dc6d13e3df5b3985256d508cfa09d153b26fa2eaf00dff864f
 
 name:           gpm
 version:        0.1.0.0
@@ -46,9 +46,6 @@ library
     , text
     , turtle
     , unix
-    , wai
-    , wai-app-static
-    , warp
   default-language: Haskell2010
 
 executable gpm
@@ -71,7 +68,4 @@ executable gpm
     , text
     , turtle
     , unix
-    , wai
-    , wai-app-static
-    , warp
   default-language: Haskell2010

package.yaml

@@ -33,9 +33,6 @@ dependencies:
 - text
 - turtle
 - unix
-- wai
-- wai-app-static
-- warp
 library:
   source-dirs: src
 executables:

playground/gpm-test.sh

@@ -1,13 +1,19 @@
 #!/usr/bin/env zsh
 
-set -x
-
 title(){
     set +x
     echo
-    print -- "----------------------------------------"
-    print -- "          $*"
-    print -- "----------------------------------------"
+    print -- "  $*  "|sed 's/./=/g'
+    print -- "  $*  "
+    print -- "  $*  "|sed 's/./=/g'
+    echo
+    set -x
+}
+subtitle() {
+    set +x
+    echo
+    print -- "$*"
+    print -- "$*"|sed 's/./-/g'
     echo
     set -x
 }
@@ -16,51 +22,66 @@ prjname="testproj"
 playgrounddir="/tmp/gpm-playground"
 testproj="$playgrounddir/$prjname"
 testproj2="$playgrounddir/testproj2"
-mkdir -p $testproj
-pushd $testproj
 
-title "CLEANING UP"
+# display all commands
+set -x
+
+# ------------------------------------------------------------------------------
+title "INIT"
+
+subtitle "Cleaning Up"
 [[ -d $testproj ]] && rm -rf $testproj
 [[ -d $testproj2 ]] && rm -rf $testproj2
 [[ -d ~/.local/share/gpm ]] && rm -rf ~/.local/share/gpm
 gpm serve stop
 
-title "CREATE PROJECT $testproj"
+subtitle "Create Project $testproj"
 mkdir $testproj
 pushd $testproj
 echo "README 1" > README
 git init .
 git add README
 git commit -m "initial commit"
-title "gpm init"
+
+subtitle "gpm init"
 gpm init
 
-title "gpm new-issue"
+# ------------------------------------------------------------------------------
+title "ISSUES"
+
+subtitle "gpm new-issue"
 gpm new-issue -t "issue-1" -p "A"
 
+# ------------------------------------------------------------------------------
 title "HOOKS"
+
+subtitle "Change Some 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"
+subtitle "gpm hooks sync"
 gpm hooks sync
 
-title "gpm serve start"
+# ------------------------------------------------------------------------------
+title "SERVE"
+
+subtitle "gpm serve start"
 gpm serve update
 gpm serve start
 popd
 mkdir $testproj2
 pushd $testproj2
-git clone http://localhost:3000/${prjname}.git $testproj2
+
+subtitle "git clone"
+git clone git://localhost:9418/${prjname}.git $testproj2
+
+subtitle "gpm serve stop"
 gpm serve stop
 popd
 
-popd
-
-echo
 echo "--------"
 echo "$testproj"
 echo "$testproj2"

src/GPM/Init.hs

@@ -26,7 +26,26 @@ import qualified GPM.Hooks     as Hooks
 -- | Init a repository with a new empty branch named @gpm@
 init :: IO ()
 init = do
-  yellow "# GPM -- Git Project Manager"
+  yellow "GPM -- Git Project Manager"
+  yellow "=========================="
+  hasGPMBranch <- checkIfRepoHasGPMBranch
+  case hasGPMBranch of
+    Just "gpm"     -> echo "You appear to already have a gpm branch."
+    Just gpmBranch -> initFromRemote gpmBranch
+    Nothing        -> rawInit
+
+checkIfRepoHasGPMBranch :: IO (Maybe Text)
+checkIfRepoHasGPMBranch =
+  fmap lineToText <$> _foldIO searchGPMBranch (Fold.generalize Fold.last)
+  where
+    searchGPMBranch = inshell "git branch -a" empty
+                      & grep ("gpm" <|> suffix "/gpm")
+
+initFromRemote :: Text -> IO ()
+initFromRemote br = debug_ $ "git branch gpm " <> br
+
+rawInit :: IO ()
+rawInit = do
   mkNewEmptyBranch "gpm"
   Issue.init
   Docs.init

src/GPM/Serve.hs

@@ -23,8 +23,6 @@ import           GPM.Helpers                    (debug, debug_, getGPMDataDir,
 
 -- | 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
@@ -107,23 +105,24 @@ handleServeStart = do
   pubDir <- getPublicDir
   inDir pubDir $ do
     pwd >>= putText . format fp
+    dirServe pubDir
     debug_ "git instaweb --http=webrick start"
-    dirServe
 
 handleServeStop :: IO ()
 handleServeStop = do
   pubDir <- getPublicDir
   inDir pubDir $ do
     pwd >>= putText . format fp
-    debug_ "git instaweb --http=webrick stop"
     dirStopServe
+    debug_ "git instaweb --http=webrick stop"
 
 handleProjectDir :: IO ()
 handleProjectDir = getPublicDir >>= putText . format fp
 
-dirServe :: IO ()
-dirServe = do
-  processId <- Process.forkProcess $ Warp.run 3000 (WaiStatic.staticApp (WaiStatic.defaultWebAppSettings "."))
+dirServe :: Turtle.FilePath -> IO ()
+dirServe pubdir = do
+  processId <- Process.forkProcess $
+    debug_ $ format ("git daemon --reuseaddr --export-all --base-path="%fp%" "%fp) pubdir pubdir
   gpmDataDir <- getGPMDataDir
   inDir gpmDataDir $ do
     mktree "procs"
@@ -135,6 +134,6 @@ dirStopServe = do
   inDir gpmDataDir $ do
     pidtxt <- readTextFile ("procs" </> "gitServePID")
     if Text.null pidtxt
-      then putErrText "The git server doesn't appear to be running"
+      then putErrText "git daemon doesn't appear to be running"
       else debug_ ("kill " <> pidtxt)