:wip: Serve git on the web support
This commit is contained in:
parent
f22c7e0e67
commit
857324468f
3 changed files with 93 additions and 25 deletions
|
@ -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"
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
67
src/GPM/Serve.hs
Normal file
67
src/GPM/Serve.hs
Normal file
|
@ -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"
|
Loading…
Reference in a new issue