specify content repository path on command line

backend/app/Main.hs

@@ -29,9 +29,11 @@ import Options.Applicative qualified as A
 import Route qualified as R
 import Safe
 import Store qualified as Q
-import System.Directory (setCurrentDirectory)
+import System.Directory (setCurrentDirectory, doesDirectoryExist)
+import System.Exit
 import System.FilePath
 import System.INotify
+import System.IO qualified as IO
 import Version
 
 data Args = Args
@@ -43,6 +45,7 @@ args = Args <$> cmd'
 
 data Cmd = Serve
   { serverPort :: Int
+  , contentRepositoryPath :: FilePath
   }
 
 cmd' :: A.Parser Cmd
@@ -55,6 +58,7 @@ cmd' =
 serveCmd :: A.Parser Cmd
 serveCmd = do
   serverPort <- A.option A.auto (A.metavar "PORT" <> A.showDefault <> A.value 8081 <> A.long "port" <> A.short 'p' <> A.help "The server port")
+  contentRepositoryPath <- A.strArgument (A.metavar "PATH" <> A.help "Path to the content repository")
   pure Serve {..}
 
 data Repo = Repo
@@ -194,15 +198,23 @@ data SchemaDifference
   | Patch
   deriving (Show, Eq, Ord)
 
+logStderr :: String -> IO ()
+logStderr = IO.hPutStrLn IO.stderr
+
 main :: IO ()
 main = do
-  setCurrentDirectory "../blog"
+  A.execParser (A.info (args <**> A.helper) A.idm) >>= \case
+    Args {cmd = Serve {contentRepositoryPath, serverPort}} -> do
+      contentRepositoryPathExists <- doesDirectoryExist (contentRepositoryPath </> ".git")
+      unless contentRepositoryPathExists $ do
+        logStderr $ "Content repository '" ++ contentRepositoryPath ++ "' is not a git repository."
+        exitFailure
+      setCurrentDirectory contentRepositoryPath
       let root = "."
           ref = "refs/heads/master"
       repoT <- newEmptyTMVarIO
       _ <- forkIO do watch repoT root ref
-  A.execParser (A.info (args <**> A.helper) A.idm) >>= \case
-    Args {cmd = Serve {serverPort}} -> do
+
       W.runEnv serverPort $ \req respond -> do
         case P.parseOnly R.parser (W.rawPathInfo req) of
           Right (R.SchemaJson path) -> do