From 4fca6d50e01aa9faea14d50393599479f1e20078 Mon Sep 17 00:00:00 2001
From: Eduardo Trujillo <ed@chromabits.com>
Date: Sat, 26 Dec 2020 15:14:29 -0800
Subject: [PATCH] feat(Server): Allow listener port to be set in CLI options
---
src/Shift.hs | 36 +++++++++++++++++++-----------------
src/Shift/CLI.hs | 10 ++++++++--
src/Shift/Server.hs | 7 ++++---
3 files changed, 31 insertions(+), 22 deletions(-)
diff --git a/src/Shift.hs b/src/Shift.hs
index 013fb94..61ea9fc 100644
--- a/src/Shift.hs
+++ b/src/Shift.hs
@@ -1,17 +1,19 @@
-module Shift
- ( shiftMain
- , module X
- ) where
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
-import Options.Applicative
+module Shift
+ ( shiftMain,
+ module X,
+ )
+where
import Control.Lens ((^.))
-
-import Shift.CLI as X
-import Shift.Git as X
+import Options.Applicative
+import Shift.CLI as X
+import Shift.Git as X
import Shift.Rendering as X
-import Shift.Types as X
import Shift.Server (runServer)
+import Shift.Types as X
-- | The main CLI entrypoint.
shiftMain :: IO ()
@@ -20,12 +22,12 @@ shiftMain = do
case currentOptions ^. soCommand of
GenerateCommand -> tempMain currentOptions
- ServeCommand -> runServer currentOptions
-
+ ServeCommand {_scPort, ..} -> runServer _scPort currentOptions
where
- opts = info (helper <*> shiftOptions)
- ( fullDesc
- <> progDesc "Execute the given COMMAND"
- <> header "shift - A change log generator"
- )
-
+ opts =
+ info
+ (helper <*> shiftOptions)
+ ( fullDesc
+ <> progDesc "Execute the given COMMAND"
+ <> header "shift - A change log generator"
+ )
diff --git a/src/Shift/CLI.hs b/src/Shift/CLI.hs
index cca83a8..92c9e4d 100644
--- a/src/Shift/CLI.hs
+++ b/src/Shift/CLI.hs
@@ -19,7 +19,7 @@ data ShiftOptions = ShiftOptions
}
deriving (Show, Eq)
-data ShiftCommand = GenerateCommand | ServeCommand deriving (Show, Eq, Enum)
+data ShiftCommand = GenerateCommand | ServeCommand {_scPort :: Maybe Int} deriving (Show, Eq)
data HostingType = GitHubType | GitType deriving (Show, Eq, Enum)
@@ -85,7 +85,13 @@ shiftCommand =
)
<> command
"serve"
- (info (pure ServeCommand) (progDesc "Start UI server"))
+ ( info
+ ( ServeCommand
+ <$> optional
+ (option auto (long "port" <> help "Web server listener port"))
+ )
+ (progDesc "Start UI server")
+ )
hostingType :: ReadM HostingType
hostingType = eitherReader $ \case
diff --git a/src/Shift/Server.hs b/src/Shift/Server.hs
index 3eaff0d..7efd445 100644
--- a/src/Shift/Server.hs
+++ b/src/Shift/Server.hs
@@ -5,13 +5,14 @@ module Shift.Server (runServer) where
import CMarkGFM (commonmarkToHtml, nodeToCommonmark, nodeToHtml)
import Control.Monad.IO.Class (MonadIO (liftIO))
+import Data.Maybe (fromMaybe)
import Data.Text.Lazy (fromChunks)
import Shift.CLI (ShiftOptions)
import Shift.Git (renderToNode)
-import Web.Scotty (rescue, rescue, get, html, param, scotty, text)
+import Web.Scotty (get, html, param, rescue, scotty, text)
-runServer :: ShiftOptions -> IO ()
-runServer options = scotty 3000 $
+runServer :: Maybe Int -> ShiftOptions -> IO ()
+runServer port options = scotty (fromMaybe 3000 port) $
get "/" $ do
(asMarkdown :: Bool) <- param "as_markdown" `rescue` (\_ -> pure False)
--
GitLab