Allow specifying (optional) host along with port

.github/workflows/ci.yaml

@@ -18,3 +18,4 @@ jobs:
         signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}'
         # Only needed for private caches
         authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
+    - run: nix-shell --run 'cabal new-test'

bin/test

@@ -0,0 +1,3 @@
+#!/usr/bin/env bash
+set -xe
+nix-shell --run "ghcid -c 'cabal new-repl test:rib-test' -T \":main $*\""

rib.cabal

@@ -1,4 +1,4 @@
-cabal-version: 2.2
+cabal-version: 2.4
 name: rib
 version: 0.9.0.0
 license: BSD-3-Clause
@@ -21,22 +21,7 @@ source-repository head
     type: git
     location: https://github.com/srid/rib
 
-library
-    exposed-modules:
-        Rib
-        Rib.App
-        Rib.Cli
-        Rib.Watch
-        Rib.Log
-        Rib.Parser.Dhall
-        Rib.Parser.MMark
-        Rib.Parser.Pandoc
-        Rib.Route
-        Rib.Shake
-        Rib.Extra.CSS
-        Rib.Extra.OpenGraph
-    other-modules:
-        Rib.Server
+common library-common
     hs-source-dirs: src
     default-language: Haskell2010
     default-extensions: NoImplicitPrelude
@@ -78,3 +63,33 @@ library
         wai >=3.2.2 && <3.3,
         wai-app-static >=3.1.6 && <3.2,
         warp
+
+library
+  import: library-common
+  exposed-modules:
+      Rib
+      Rib.App
+      Rib.Cli
+      Rib.Watch
+      Rib.Log
+      Rib.Parser.Dhall
+      Rib.Parser.MMark
+      Rib.Parser.Pandoc
+      Rib.Route
+      Rib.Shake
+      Rib.Extra.CSS
+      Rib.Extra.OpenGraph
+  other-modules:
+      Rib.Server
+
+test-suite rib-test 
+  import: library-common
+  type: exitcode-stdio-1.0
+  hs-source-dirs: test 
+  main-is: Spec.hs
+  build-depends:
+    base,
+    relude,
+    hspec,
+    QuickCheck
+

src/Rib/App.hs

@@ -59,14 +59,14 @@ runWith buildAction cfg@CliConfig {..} = do
   -- For saner output
   flip hSetBuffering LineBuffering `mapM_` [stdout, stderr]
   case (watch, serve) of
-    (True, Just port) -> do
+    (True, Just (host, port)) -> do
       race_
-        (Server.serve cfg port $ toFilePath outputDir)
+        (Server.serve cfg host port $ toFilePath outputDir)
         (runShakeAndObserve cfg buildAction)
     (True, Nothing) ->
       runShakeAndObserve cfg buildAction
-    (False, Just port) ->
-      Server.serve cfg port $ toFilePath outputDir
+    (False, Just (host, port)) ->
+      Server.serve cfg host port $ toFilePath outputDir
     (False, Nothing) ->
       runShakeBuild cfg buildAction
   where

src/Rib/Cli.hs

@@ -8,6 +8,9 @@
 module Rib.Cli
   ( CliConfig (..),
     cliParser,
+
+    -- * Internal
+    parseHostPort,
   )
 where
 
@@ -16,6 +19,8 @@ import Options.Applicative
 import Path
 import Relude
 import Relude.Extra.Tuple
+import qualified Text.Megaparsec as M
+import qualified Text.Megaparsec.Char as M
 
 -- Rib's CLI configuration
 --
@@ -27,7 +32,7 @@ data CliConfig
         -- | Whether to monitor `inputDir` for changes and re-generate
         watch :: Bool,
         -- | Whether to run a HTTP server on `outputDir`
-        serve :: Maybe Int,
+        serve :: Maybe (Text, Int),
         -- | Shake's verbosity level.
         --
         -- Setting this to `Silent` will affect Rib's own logging as well.
@@ -57,13 +62,13 @@ cliParser inputDirDefault outputDirDefault = do
       )
   serve <-
     optional
-      ( option
-          auto
-          ( long "serve"
-              <> short 's'
-              <> metavar "PORT"
-              <> help "Run a HTTP server on the generated directory"
-          )
+      ( fmap parseHostPort $
+          strOption
+            ( long "serve"
+                <> short 's'
+                <> metavar "[HOST]:PORT"
+                <> help "Run a HTTP server on the generated directory"
+            )
       )
   verbosity <-
     fmap
@@ -98,3 +103,32 @@ shakeDbDirFrom inputDir =
   -- (default) current working directory, which may not always be a project
   -- root (as in the case of neuron).
   inputDir </> [reldir|.shake|]
+
+parseHostPort :: Text -> (Text, Int)
+parseHostPort =
+  parse $ do
+    host <-
+      optional $
+        M.string "localhost"
+          <|> parseIP
+    void $ M.char ':'
+    port <- parseNumRange 1 65535
+    pure (fromMaybe "127.0.0.1" host, port)
+  where
+    readNum = fromMaybe (error "Not a number") . readMaybe
+    parseIP :: M.Parsec Void Text Text
+    parseIP = do
+      a <- parseNumRange 0 255 <* M.char '.'
+      b <- parseNumRange 0 255 <* M.char '.'
+      c <- parseNumRange 0 255 <* M.char '.'
+      d <- parseNumRange 0 255
+      pure $ toText $ intercalate "." $ show <$> [a, b, c, d]
+    parseNumRange :: Int -> Int -> M.Parsec Void Text Int
+    parseNumRange a b = do
+      n <- fmap readNum $ M.some M.digitChar
+      if a <= n && n <= b
+        then pure n
+        else fail $ "Number not in range: " <> show a <> "-" <> show b
+    -- Handy utility for parsing
+    parse :: M.Parsec Void Text a -> Text -> a
+    parse p = either (error . toText . M.errorBundlePretty) id . M.parse p "<user input>"

src/Rib/Server.hs

@@ -18,18 +18,19 @@ import Rib.Log
 -- Binds the server to host 127.0.0.1.
 serve ::
   CliConfig ->
+  -- | Host
+  Text ->
   -- | Port number to bind to
   Int ->
   -- | Directory to serve.
   FilePath ->
   IO ()
-serve cfg port path = do
-  logStrLn cfg $ "[Rib] Serving " <> path <> " at http://" <> host <> ":" <> show port
+serve cfg host port path = do
+  logStrLn cfg $ "[Rib] Serving " <> path <> " at http://" <> toString host <> ":" <> show port
   Warp.runSettings settings app
   where
     app = staticApp $ defaultFileServerSettings path
-    host = "127.0.0.1"
     settings =
-      Warp.setHost (fromString host)
+      Warp.setHost (fromString $ toString host)
         $ Warp.setPort port
         $ Warp.defaultSettings

test/Rib/CliSpec.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Rib.CliSpec
+  ( spec,
+  )
+where
+
+import Relude
+import Rib.Cli
+import Test.Hspec
+
+spec :: Spec
+spec = do
+  describe "Host and Port parsing" $ do
+    it "should parse port" $ do
+      parseHostPort ":8080" `shouldBe` ("127.0.0.1", 8080)
+    it "should parse localhost" $ do
+      parseHostPort "localhost:8080" `shouldBe` ("localhost", 8080)
+    it "should parse IP addr" $ do
+      parseHostPort "132.45.0.254:8080" `shouldBe` ("132.45.0.254", 8080)

test/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}