diff --git a/src/Shift.hs b/src/Shift.hs index 013fb94f11393c69f112c52515cea33c812220bf..61ea9fc5fdc2a5e15817a27eb0facf92f4a4cbf9 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 cca83a8cf5814ca8663483922c6df3c7906fdf22..92c9e4def09953157cbce122c93fac3dc591eb46 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 3eaff0d12b153c88a39ae65ab3a67046bfc18d90..7efd445d3e27faf6f3127f04e8f33afc6cddbb3b 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)