Improves OpenAPI spec names and types and error reporting

.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)