log which path the backend serves, and where
This commit is contained in:
@@ -29,7 +29,7 @@ import Options.Applicative qualified as A
|
|||||||
import Route qualified as R
|
import Route qualified as R
|
||||||
import Safe
|
import Safe
|
||||||
import Store qualified as Q
|
import Store qualified as Q
|
||||||
import System.Directory (setCurrentDirectory, doesDirectoryExist)
|
import System.Directory (setCurrentDirectory, doesDirectoryExist, makeAbsolute)
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.INotify
|
import System.INotify
|
||||||
@@ -205,16 +205,21 @@ main :: IO ()
|
|||||||
main = do
|
main = do
|
||||||
A.execParser (A.info (args <**> A.helper) A.idm) >>= \case
|
A.execParser (A.info (args <**> A.helper) A.idm) >>= \case
|
||||||
Args {cmd = Serve {contentRepositoryPath, serverPort}} -> do
|
Args {cmd = Serve {contentRepositoryPath, serverPort}} -> do
|
||||||
contentRepositoryPathExists <- doesDirectoryExist (contentRepositoryPath </> ".git")
|
contentRepositoryPath' <- makeAbsolute contentRepositoryPath
|
||||||
|
contentRepositoryPathExists <- doesDirectoryExist (contentRepositoryPath' </> ".git")
|
||||||
|
|
||||||
unless contentRepositoryPathExists $ do
|
unless contentRepositoryPathExists $ do
|
||||||
logStderr $ "Content repository '" ++ contentRepositoryPath ++ "' is not a git repository."
|
logStderr $ "Content repository '" ++ contentRepositoryPath ++ "' is not a git repository."
|
||||||
exitFailure
|
exitFailure
|
||||||
setCurrentDirectory contentRepositoryPath
|
|
||||||
|
setCurrentDirectory contentRepositoryPath'
|
||||||
let root = "."
|
let root = "."
|
||||||
ref = "refs/heads/master"
|
ref = "refs/heads/master"
|
||||||
repoT <- newEmptyTMVarIO
|
repoT <- newEmptyTMVarIO
|
||||||
_ <- forkIO do watch repoT root ref
|
_ <- forkIO do watch repoT root ref
|
||||||
|
|
||||||
|
logStderr ("Serving " ++ contentRepositoryPath' ++ " on port " ++ show serverPort ++ ".")
|
||||||
|
|
||||||
W.runEnv serverPort $ \req respond -> do
|
W.runEnv serverPort $ \req respond -> do
|
||||||
case P.parseOnly R.parser (W.rawPathInfo req) of
|
case P.parseOnly R.parser (W.rawPathInfo req) of
|
||||||
Right (R.SchemaJson path) -> do
|
Right (R.SchemaJson path) -> do
|
||||||
|
|||||||
Reference in New Issue
Block a user