Improves OpenAPI spec names and types and error reporting

This uses the new `json-fleece` API to improve the names and types
given to OpenAPI specs.

This includes a change that restricts the characters allowed in the name
of an OpenAPI spec. This default is to allow alphanumeric characters, plus
'.' and '_'. The list of allowed characters can be specified both via
the various functions that build OpenAPI specs and the default command
line generation command.

This also improves the error reporting when schemas have conflicts or
bad names to try to provide context of where the offending spec is
contained within the spec definitions so that the developer can more
easily locate the offending specs within the code.

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
 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
@@ -127,6 +127,7 @@ test-suite orb-test
       Fixtures.OpenApiSubset
       Fixtures.SimpleGet
       Fixtures.SimplePost
+      Fixtures.TaggedUnion
       Fixtures.Union
       Handler
       OpenApi

package.yaml

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

src/Orb/Main.hs

@@ -1,16 +1,20 @@
 module Orb.Main
   ( main
+  , mainWithOptions
   , mainParserInfo
   , mainParser
   , mainParserWithCommands
+  , openApiOptionsParser
   , openApiLabelArgument
   , generateOpenApiCommand
   , generateOpenApiMain
   ) where
 
 import Data.Aeson.Encode.Pretty qualified as AesonPretty
 import Data.ByteString.Lazy qualified as LBS
+import Data.Foldable (traverse_)
 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
@@ -30,25 +34,64 @@ import Orb.OpenApi qualified as OpenApi
     of the labeled routes as JSON to stdout.
 -}
 main :: OpenApi.OpenApiRouter a -> IO () -> IO ()
-main routes appMain = do
-  io <- Opt.customExecParser parserPrefs (mainParserInfo appMain routes)
+main =
+  mainWithOptions OpenApi.defaultOpenApiOptions
+
+{- |
+  Constructs a main function that parses the command line arguments and
+  provides two subcommands in the executable:
+
+  - @api@ - runs the IO action provided as the main. Presumably this
+    invokes some form of 'Orb.Wai.runOrb' (or otherwise runs a way server)
+    that serves an application handling the routes provided to this function.
+
+  - @generate-open-api@ - accepts a argument matching one of the labels
+    provided to 'OpenApi.provideOpenApi' and prints an OpenApi description
+    of the labeled routes as JSON to stdout.
+
+
+  A version of 'main' takes an 'OpenApi.OpenApiOptions'
+  value to use as the default options to the @generate-open-api@
+  command.  If you use this function, you probably also want
+  to use 'Orb.SwaggerUI.swaggerUIRoutesWithOptions' instead of
+  'Orb.SwaggerUI.swaggerUIRoutes' and specify the same options that
+  you're passing to this function.
+-}
+mainWithOptions :: OpenApi.OpenApiOptions -> OpenApi.OpenApiRouter a -> IO () -> IO ()
+mainWithOptions defaultOptions routes appMain = do
+  io <- Opt.customExecParser parserPrefs (mainParserInfo defaultOptions appMain routes)
   io
 
 {- |
   Constructs a 'Opt.ParserInfo' that will execute as description in 'main', but
   can be used as an argument to 'Opt.command' to use it as a subcommand.
+
+  The options passed will be used as the default values for when no options
+  are specified on the command line.
 -}
-mainParserInfo :: IO () -> OpenApi.OpenApiRouter a -> Opt.ParserInfo (IO ())
-mainParserInfo apiMain routes =
-  Opt.info (mainParser apiMain routes) mempty
+mainParserInfo ::
+  OpenApi.OpenApiOptions ->
+  IO () ->
+  OpenApi.OpenApiRouter a ->
+  Opt.ParserInfo (IO ())
+mainParserInfo defaultOptions apiMain routes =
+  Opt.info (mainParser defaultOptions apiMain routes) mempty
 
 {- |
   Constructs a 'Opt.Parser' that will execute as description in 'main', but
   can be used directly in other option parsers.
+
+  The options passed will be used as the default values for when no options
+  are specified on the command line.
 -}
-mainParser :: IO () -> OpenApi.OpenApiRouter a -> Opt.Parser (IO ())
-mainParser apiMain =
+mainParser ::
+  OpenApi.OpenApiOptions ->
+  IO () ->
+  OpenApi.OpenApiRouter a ->
+  Opt.Parser (IO ())
+mainParser defaultOptions apiMain =
   mainParserWithCommands
+    defaultOptions
     [ Opt.command "api" (Opt.info (pure apiMain) mempty)
     ]
 
@@ -57,15 +100,19 @@ mainParser apiMain =
   the 'main' function along with the other commands passed. In this case no
   @api@ command is added by orb. It is up to the application to passed
   whatever set of other commands it desires.
+
+  The options passed will be used as the default values for when no options
+  are specified on the command line.
 -}
 mainParserWithCommands ::
+  OpenApi.OpenApiOptions ->
   [Opt.Mod Opt.CommandFields (IO ())] ->
   OpenApi.OpenApiRouter a ->
   Opt.Parser (IO ())
-mainParserWithCommands commands routes =
+mainParserWithCommands defaultOptions commands routes =
   Opt.hsubparser $
     mconcat
-      ( generateOpenApiCommand routes
+      ( generateOpenApiCommandWithOptions defaultOptions routes
           : commands
       )
 
@@ -74,9 +121,67 @@ mainParserWithCommands commands routes =
   can be used along with 'Opt.hsubparser' include the command wherever the user
   chooses in their options parsing.
 -}
-generateOpenApiCommand :: OpenApi.OpenApiRouter a -> Opt.Mod Opt.CommandFields (IO ())
+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 OpenApi.defaultOpenApiOptions
+        <*> pure routes
+        <*> openApiLabelArgument routes
+  in
+    Opt.command "generate-open-api" (Opt.info parser mempty)
+
+{- |
+  Constructs an 'Opt.command' modifier for the @generate-open-api@ command that
+  can be used along with 'Opt.hsubparser' include the command wherever the user
+  chooses in their options parsing.
+
+  The options passed will be used as the default values for when no options
+  are specified on the command line.
+
+  A version of 'generateOpenApiCommand' that takes the options argument.
+-}
+generateOpenApiCommandWithOptions ::
+  OpenApi.OpenApiOptions ->
+  OpenApi.OpenApiRouter a ->
+  Opt.Mod Opt.CommandFields (IO ())
+generateOpenApiCommandWithOptions defaultOptions routes =
+  let
+    parser =
+      generateOpenApiMain
+        <$> openApiOptionsParser defaultOptions
+        <*> 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.
+
+  The options passed will be used as the default values for when no options
+  are specified on the command line.
+-}
+openApiOptionsParser :: OpenApi.OpenApiOptions -> Opt.Parser OpenApi.OpenApiOptions
+openApiOptionsParser defaultOptions =
+  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 defaultOptions))
+            <> Opt.showDefault
+        )
 
 {- |
   Constructs a 'Opt.Parser' than will parse an argument representing one
@@ -110,12 +215,12 @@ 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
-    Left err -> do
+generateOpenApiMain :: OpenApi.OpenApiOptions -> OpenApi.OpenApiRouter a -> String -> IO ()
+generateOpenApiMain options routes label =
+  case OpenApi.mkOpenApi options routes label of
+    Left errs -> do
       IO.hPutStrLn IO.stderr ("Unable to generate OpenApi Spec for " <> label <> "!")
-      IO.hPutStrLn IO.stderr err
+      traverse_ (IO.hPutStrLn IO.stderr . OpenApi.renderOpenApiError) errs
       Exit.exitWith (Exit.ExitFailure 1)
     Right openApi ->
       LBS.putStr (AesonPretty.encodePretty openApi)