added command to show dir

This commit is contained in:
Yann Esposito (Yogsototh) 2018-10-16 21:28:23 +02:00
parent 8ac433e8d1
commit 57565e4235
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646

View file

@ -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