feat(Server): Allow listener port to be set in CLI options

src/Shift.hs

-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"
+        )

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

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)