diff options
Diffstat (limited to 'backend/app/Main.hs')
-rw-r--r-- | backend/app/Main.hs | 26 |
1 files changed, 19 insertions, 7 deletions
diff --git a/backend/app/Main.hs b/backend/app/Main.hs index bec530e..38ad1f1 100644 --- a/backend/app/Main.hs +++ b/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" - 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 + 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 + W.runEnv serverPort $ \req respond -> do case P.parseOnly R.parser (W.rawPathInfo req) of Right (R.SchemaJson path) -> do |