allow customization of backend port
This commit is contained in:
@@ -1,3 +1,6 @@
|
|||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE ApplicativeDo #-}
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import AutoTypes qualified as U
|
import AutoTypes qualified as U
|
||||||
@@ -39,6 +42,8 @@ args :: A.Parser Args
|
|||||||
args = Args <$> cmd'
|
args = Args <$> cmd'
|
||||||
|
|
||||||
data Cmd = Serve
|
data Cmd = Serve
|
||||||
|
{ serverPort :: Int
|
||||||
|
}
|
||||||
|
|
||||||
cmd' :: A.Parser Cmd
|
cmd' :: A.Parser Cmd
|
||||||
cmd' =
|
cmd' =
|
||||||
@@ -48,7 +53,9 @@ cmd' =
|
|||||||
]
|
]
|
||||||
|
|
||||||
serveCmd :: A.Parser Cmd
|
serveCmd :: A.Parser Cmd
|
||||||
serveCmd = pure Serve
|
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")
|
||||||
|
pure Serve {..}
|
||||||
|
|
||||||
data Repo = Repo
|
data Repo = Repo
|
||||||
{ commits :: [Commit]
|
{ commits :: [Commit]
|
||||||
@@ -195,8 +202,8 @@ main = do
|
|||||||
repoT <- newEmptyTMVarIO
|
repoT <- newEmptyTMVarIO
|
||||||
_ <- forkIO do watch repoT root ref
|
_ <- forkIO do watch repoT root ref
|
||||||
A.execParser (A.info (args <**> A.helper) A.idm) >>= \case
|
A.execParser (A.info (args <**> A.helper) A.idm) >>= \case
|
||||||
Args {cmd = Serve} -> do
|
Args {cmd = Serve {serverPort}} -> do
|
||||||
W.runEnv 8081 $ \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
|
||||||
repo <- atomically (readTMVar repoT)
|
repo <- atomically (readTMVar repoT)
|
||||||
|
|||||||
Reference in New Issue
Block a user