serve basics

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:

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

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

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"
 

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"