added command to show dir
This commit is contained in:
parent
8ac433e8d1
commit
57565e4235
1 changed files with 13 additions and 4 deletions
|
@ -67,6 +67,7 @@ init = do
|
||||||
data ServeCommand = ServeStart
|
data ServeCommand = ServeStart
|
||||||
| ServeStop
|
| ServeStop
|
||||||
| ServeUpdate
|
| ServeUpdate
|
||||||
|
| ProjectDir
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
||||||
parseServeCommand :: Parser ServeCommand
|
parseServeCommand :: Parser ServeCommand
|
||||||
|
@ -74,27 +75,35 @@ parseServeCommand =
|
||||||
subcommand "start" "Start to serve all gpm tracked repositories" (pure ServeStart)
|
subcommand "start" "Start to serve all gpm tracked repositories" (pure ServeStart)
|
||||||
<|> subcommand "stop" "Stop to serve all gpm tracked repositories" (pure ServeStop)
|
<|> subcommand "stop" "Stop to serve all gpm tracked repositories" (pure ServeStop)
|
||||||
<|> subcommand "update" "Update the served git repository" (pure ServeUpdate)
|
<|> 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 :: ServeCommand -> Text -> IO ()
|
||||||
handleServe ServeStart _ = handleServeStart
|
handleServe ServeStart _ = handleServeStart
|
||||||
handleServe ServeStop _ = handleServeStop
|
handleServe ServeStop _ = handleServeStop
|
||||||
handleServe ServeUpdate _ = handleUpdate
|
handleServe ServeUpdate _ = handleUpdate
|
||||||
|
handleServe ProjectDir _ = handleProjectDir
|
||||||
|
|
||||||
handleUpdate :: IO ()
|
handleUpdate :: IO ()
|
||||||
handleUpdate = do
|
handleUpdate = do
|
||||||
pubPrjDir <- getPublicPrjDir
|
pubPrjDir <- getPublicPrjDir
|
||||||
inDir pubPrjDir $
|
inDir pubPrjDir $ do
|
||||||
debug_ "git pull"
|
pwd >>= putText . format fp
|
||||||
|
debug_ "git fetch"
|
||||||
|
|
||||||
handleServeStart :: IO ()
|
handleServeStart :: IO ()
|
||||||
handleServeStart = do
|
handleServeStart = do
|
||||||
pubDir <- getPublicDir
|
pubDir <- getPublicDir
|
||||||
inDir pubDir $
|
inDir pubDir $ do
|
||||||
|
pwd >>= putText . format fp
|
||||||
debug_ "git instaweb --http=webrick start"
|
debug_ "git instaweb --http=webrick start"
|
||||||
-- TODO: Do not forget to also git serve
|
-- TODO: Do not forget to also git serve
|
||||||
|
|
||||||
handleServeStop :: IO ()
|
handleServeStop :: IO ()
|
||||||
handleServeStop = do
|
handleServeStop = do
|
||||||
pubDir <- getPublicDir
|
pubDir <- getPublicDir
|
||||||
inDir pubDir $
|
inDir pubDir $ do
|
||||||
|
pwd >>= putText . format fp
|
||||||
debug_ "git instaweb --http=webrick stop"
|
debug_ "git instaweb --http=webrick stop"
|
||||||
|
|
||||||
|
handleProjectDir :: IO ()
|
||||||
|
handleProjectDir = getPublicDir >>= putText . format fp
|
||||||
|
|
Loading…
Reference in a new issue