:wip: Serve git on the web support

src/GPM/Helpers.hs

@@ -10,7 +10,7 @@ module GPM.Helpers
   ( debug
   , debug_
   , getCurrentGitBranch
-  , getGPMCacheDir
+  , getGPMDataDir
   , getGitUser
   , inGPM
   )
@@ -56,6 +56,6 @@ inGPM = bracket safeChangeBranch safeReturnBranch
       debug_ "git stash pop"
 
 -- | Retrieve the cache directory to save temporary files in gpm
-getGPMCacheDir :: IO Turtle.FilePath
-getGPMCacheDir = fromString <$> Directory.getXdgDirectory Directory.XdgCache "gpm"
+getGPMDataDir :: IO Turtle.FilePath
+getGPMDataDir = fromString <$> Directory.getXdgDirectory Directory.XdgData "gpm"
 

src/GPM/Review.hs

@@ -22,7 +22,7 @@ import           Protolude      hiding (ask, die, (%),stdout)
 import           Turtle
 
 import           Data.FileEmbed (embedStringFile)
-import           GPM.Helpers    (getGPMCacheDir, debug_, getGitUser)
+import           GPM.Helpers    (getGPMDataDir, debug_, getGitUser)
 import           Text.Mustache
 import qualified Data.Text as Text
 import qualified Data.Char as Char
@@ -52,11 +52,31 @@ init = do
   debug_ "git add templates"
 
 
+-- | Command Line Options
 data ReviewOptions = ReviewOptions
                     { interactive :: Bool
                     , newReview    :: NewReview
                     } deriving (Eq)
 
+data NewReview =
+  NewReview { status      :: Text
+            , title       :: Text
+            , user        :: Maybe User
+            , branch      :: Maybe Text
+            , description :: Maybe Text
+            } deriving (Eq)
+
+type User = Text
+
+instance ToMustache NewReview where
+  toMustache NewReview{..} = object
+    [ "status"      ~> status
+    , "title"       ~> title
+    , "user"        ~> user
+    , "branch"      ~> branch
+    , "description" ~> description
+    ]
+
 parseFullReviewOptions :: Parser ReviewOptions
 parseFullReviewOptions =
   ReviewOptions
@@ -194,30 +214,11 @@ validTmpNewReview br = do
   debug_ $ "git add " <> toS (format fp dstReview)
   debug_ $ "git commit -m \"review for " <> br <> "\""
 
-data NewReview =
-  NewReview { status      :: Text
-            , title       :: Text
-            , user        :: Maybe User
-            , branch      :: Maybe Text
-            , description :: Maybe Text
-            } deriving (Eq)
-
-type User = Text
-
-instance ToMustache NewReview where
-  toMustache NewReview{..} = object
-    [ "status"      ~> status
-    , "title"       ~> title
-    , "user"        ~> user
-    , "branch"      ~> branch
-    , "description" ~> description
-    ]
-
 getTmpReviewFile :: Text -> IO Turtle.FilePath
 getTmpReviewFile br = do
-  cacheDir <- getGPMCacheDir
+  gpmDataDir <- getGPMDataDir
   let reviewFilename = "review-" <> protectStr br <> ".org"
-  return $ cacheDir </> fromString (toS reviewFilename)
+  return $ gpmDataDir </> fromString (toS reviewFilename)
 
 createTmpNewReview :: NewReview -> IO ()
 createTmpNewReview nr = do

src/GPM/Serve.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-|
+module      : GPM.Serve
+Description : GPM review related commands
+License     : Public Domain
+Maintainer  : yann.esposito@gmail.com
+-}
+module GPM.Serve
+  ( init
+  )
+where
+
+import           Protolude      hiding (ask, die, (%),stdout)
+import           Turtle
+
+import           GPM.Helpers    (getGPMDataDir, debug, debug_)
+
+getPublicDir :: IO Turtle.FilePath
+getPublicDir = do
+  gpmDataDir <- getGPMDataDir
+  let publicdir = gpmDataDir </> "public"
+  return publicdir
+
+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
+
+
+-- | init gpm branch to handle reviews
+init :: IO ()
+init = do
+  echo "* server init"
+  publicdir <- getPublicDir
+  mktree publicdir
+  debug_ "git init ."
+  output (publicdir </> ".git" </> "description") "Main repositories"
+  publicProjectDir <- getPublicPrjDir
+  inDir publicProjectDir $ do
+    mv ("hooks" </> "post-update.sample") ("hooks" </> "post-update")
+    _ <- chmod executable ("hooks" </> "post-update")
+    debug_ "git update-server-info"
+
+handleUpdate :: IO ()
+handleUpdate = do
+  pubPrjDir <- getPublicPrjDir
+  inDir pubPrjDir $
+    debug_ "git pull"
+
+handleServe :: IO ()
+handleServe = do
+  pubDir <- getPublicDir
+  inDir pubDir $
+    debug_ "git instaweb --http=webrick"