WIP: Improves names in generated OpenAPI specs

Author: qxjit

.helix/languages.toml

@@ -0,0 +1,8 @@
+[language-server.haskell-language-server]
+command = "docker"
+args = ["compose", "run", "--rm", "-T", "dev", "haskell-language-server-wrapper", "--lsp"]
+
+[language-server.haskell-language-server.config]
+haskell.formattingProvider = "fourmolu"
+haskell.plugin.hlint.globalOn = false
+

orb.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           orb
-version:        0.5.0.2
+version:        0.6.0.0.5
 description:    Please see the README on GitHub at <https://github.com/flipstone/orb#readme>
 homepage:       https://github.com/flipstone/orb#readme
 bug-reports:    https://github.com/flipstone/orb/issues

package.yaml

@@ -1,5 +1,5 @@
 name:                orb
-version:             0.5.0.2
+version:             0.6.0.0.5
 github:              "flipstone/orb"
 license:             MIT
 author:              "Flipstone Technology Partners, Inc"

src/Orb/Main.hs

@@ -3,6 +3,7 @@ module Orb.Main
   , mainParserInfo
   , mainParser
   , mainParserWithCommands
+  , openApiOptionsParser
   , openApiLabelArgument
   , generateOpenApiCommand
   , generateOpenApiMain
@@ -11,6 +12,7 @@ module Orb.Main
 import Data.Aeson.Encode.Pretty qualified as AesonPretty
 import Data.ByteString.Lazy qualified as LBS
 import Data.List qualified as List
+import Data.Set qualified as Set
 import Options.Applicative qualified as Opt
 import System.Exit qualified as Exit
 import System.IO qualified as IO
@@ -76,7 +78,36 @@ mainParserWithCommands commands routes =
 -}
 generateOpenApiCommand :: OpenApi.OpenApiRouter a -> Opt.Mod Opt.CommandFields (IO ())
 generateOpenApiCommand routes =
-  Opt.command "generate-open-api" (Opt.info (generateOpenApiMain routes <$> openApiLabelArgument routes) mempty)
+  let
+    parser =
+      generateOpenApiMain
+        <$> openApiOptionsParser
+        <*> pure routes
+        <*> openApiLabelArgument routes
+  in
+    Opt.command "generate-open-api" (Opt.info parser mempty)
+
+{- |
+  Constructs a 'Opt.Parser' that will parse command line options to control
+  how the OpenApi spec is generated.
+-}
+openApiOptionsParser :: Opt.Parser OpenApi.OpenApiOptions
+openApiOptionsParser =
+  let
+    mkOpts allowedChars =
+      OpenApi.defaultOpenApiOptions
+        { OpenApi.openApiAllowedSchemaNameChars = Set.fromList allowedChars
+        }
+  in
+    mkOpts
+      <$> Opt.option
+        Opt.str
+        ( Opt.long "allowed-chars"
+            <> Opt.metavar "CHARS"
+            <> Opt.help "e.g. abcdefg12345"
+            <> Opt.value (Set.toList (OpenApi.openApiAllowedSchemaNameChars OpenApi.defaultOpenApiOptions))
+            <> Opt.showDefault
+        )
 
 {- |
   Constructs a 'Opt.Parser' than will parse an argument representing one
@@ -110,9 +141,9 @@ parserPrefs =
   the @generate-open-api@ command in their own main functions without
   using @optparse-applicative@.
 -}
-generateOpenApiMain :: OpenApi.OpenApiRouter a -> String -> IO ()
-generateOpenApiMain routes label =
-  case OpenApi.mkOpenApi routes label of
+generateOpenApiMain :: OpenApi.OpenApiOptions -> OpenApi.OpenApiRouter a -> String -> IO ()
+generateOpenApiMain options routes label =
+  case OpenApi.mkOpenApi options routes label of
     Left err -> do
       IO.hPutStrLn IO.stderr ("Unable to generate OpenApi Spec for " <> label <> "!")
       IO.hPutStrLn IO.stderr err