Support generating arrays without explicit items

src/Tie/Codegen/Response.hs

@@ -67,9 +67,10 @@ codegenResponses resolver Operation {..} = do
           True
 
       requiresCustomShowInstance =
-        not $ all
-          canDeriveStockShowInstanceForResponse
-          (maybeToList defaultResponse ++ map snd responses)
+        not $
+          all
+            canDeriveStockShowInstanceForResponse
+            (maybeToList defaultResponse ++ map snd responses)
 
       decl =
         "data" <+> toApiResponseTypeName name <> PP.line

src/Tie/Codegen/Schema.hs

@@ -224,6 +224,12 @@ codegenOneOfType getDiscriminator typName variants = do
   pure (PP.vsep [decl, mempty, toJson, mempty, fromJson])
 
 codegenObjectType :: Monad m => Name -> ObjectType (Named Type) -> m (Doc ann)
+codegenObjectType typName ObjectType {..}
+  -- for empty, free form objects, just generate a type synonym for Value.
+  | freeFormObjectType,
+    null properties =
+    pure $
+      "type" <+> toDataTypeName typName <+> "=" <+> "Data.Aeson.Value"
 codegenObjectType typName ObjectType {..} = do
   -- Now generate for the object itself
   let orderedProperties =

src/Tie/Type.hs

@@ -257,7 +257,18 @@ schemaToType resolver schema
             OpenApi.OpenApiItemsArray _itemsSchemaRefs ->
               undefined -- TODO find out what tuple schemas are
         | otherwise ->
-          undefined -- TODO array type without items
+          pure $
+            Array
+              ( Unnamed
+                  ( Object
+                      ( ObjectType
+                          { properties = mempty,
+                            requiredProperties = mempty,
+                            freeFormObjectType = True
+                          }
+                      )
+                  )
+              )
       OpenApi.OpenApiNull ->
         undefined -- TODO need a BasicType for that
       OpenApi.OpenApiObject ->

test/golden/bug-1.yaml

@@ -0,0 +1,22 @@
+openapi: "3.0.0"
+info:
+  version: 1.0.0
+  title: Scarf
+  license:
+    name: AllRightsReserved
+servers:
+  - url: https://scarf.sh/api/v1
+paths:
+  /test:
+    get:
+      summary: test
+      operationId: test
+      responses:
+        '200':
+          description: CSV response without schema
+          content:
+            application/json: 
+              schema:
+                description: Undocumented
+                type: array
+components: {}

test/golden/bug-1.yaml.out

@@ -0,0 +1,367 @@
+Test/Api.hs
+
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+module Test.Api where
+
+import qualified Control.Applicative
+import qualified Control.Exception
+import qualified Control.Monad
+import qualified Control.Monad.Catch
+import qualified Control.Monad.IO.Class
+import qualified Data.Aeson
+import qualified Data.Aeson.Encoding
+import qualified Data.Aeson.Parser
+import qualified Data.Aeson.Types
+import qualified Data.Attoparsec.ByteString
+import qualified Data.List
+import qualified Data.Maybe
+import qualified Data.Text
+import qualified Data.Time
+import qualified Data.Text.Encoding
+import qualified GHC.Float
+import qualified GHC.Int
+import qualified GHC.Types
+import qualified Network.HTTP.Types
+import qualified Network.Wai
+import qualified Web.HttpApiData
+
+import Test.Request
+import Test.Response
+
+
+
+
+
+import Test.Response.Test
+
+data Api m = Api {
+    -- | test
+    test ::
+        m TestResponse
+}
+
+application :: (Control.Monad.Catch.MonadCatch m, Control.Monad.IO.Class.MonadIO m) => (forall a . Network.Wai.Request -> m a -> IO a) -> Api m -> Network.Wai.Application -> Network.Wai.Application
+application run api notFound request respond =
+    case Network.Wai.pathInfo request of
+        ["test"] ->
+            case Network.Wai.requestMethod request of
+                "GET" ->
+                    run request (do
+                        response <- Control.Monad.Catch.handle pure (test api)
+                        Control.Monad.IO.Class.liftIO (respond $! (toResponse response))
+                    )
+                x ->
+                    unsupportedMethod x
+
+        _ ->
+            notFound request respond
+    where
+        unsupportedMethod _ =
+            respond (Network.Wai.responseBuilder (toEnum 405) [] mempty)
+---------------------
+Test/Request.hs
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Test.Request
+  ( pathVariable,
+    requiredQueryParameter,
+    optionalQueryParameter,
+    requiredHeader,
+    optionalHeader,
+    parseRequestBody,
+    jsonBodyParser,
+    formBodyParser,
+  )
+where
+
+import Data.Aeson (FromJSON, parseJSON)
+import qualified Data.Aeson.Parser
+import qualified Data.Aeson.Types
+import Data.Attoparsec.ByteString (eitherResult, parseWith)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.List as List
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+import Network.HTTP.Types (HeaderName, hContentType)
+import qualified Network.Wai as Wai
+import System.IO.Unsafe (unsafeInterleaveIO)
+import Web.FormUrlEncoded (FromForm, urlDecodeAsForm)
+import Web.HttpApiData
+  ( FromHttpApiData,
+    parseHeader,
+    parseQueryParam,
+    parseUrlPiece,
+  )
+
+pathVariable ::
+  FromHttpApiData a =>
+  -- | Path variable value
+  Text ->
+  (a -> Wai.Application) ->
+  Wai.Application
+pathVariable value withVariable = \request respond ->
+  case parseUrlPiece value of
+    Left _err ->
+      respond (Wai.responseBuilder (toEnum 400) [] mempty)
+    Right x ->
+      withVariable x request respond
+{-# INLINEABLE pathVariable #-}
+
+requiredQueryParameter ::
+  FromHttpApiData a =>
+  ByteString ->
+  (a -> Wai.Application) ->
+  Wai.Application
+requiredQueryParameter name withParam = \request respond ->
+  case List.lookup name (Wai.queryString request) of
+    Nothing ->
+      respond (Wai.responseBuilder (toEnum 400) [] mempty)
+    Just Nothing ->
+      respond (Wai.responseBuilder (toEnum 400) [] mempty)
+    Just (Just value) ->
+      case parseQueryParam (Text.decodeUtf8 value) of
+        Left _err ->
+          respond (Wai.responseBuilder (toEnum 400) [] mempty)
+        Right x ->
+          withParam x request respond
+{-# INLINEABLE requiredQueryParameter #-}
+
+optionalQueryParameter ::
+  FromHttpApiData a =>
+  ByteString ->
+  -- | Allow empty, e.g. "x="
+  Bool ->
+  (Maybe a -> Wai.Application) ->
+  Wai.Application
+optionalQueryParameter name allowEmpty withParam = \request respond ->
+  case List.lookup name (Wai.queryString request) of
+    Nothing ->
+      withParam Nothing request respond
+    Just Nothing
+      | allowEmpty ->
+        withParam Nothing request respond
+      | otherwise ->
+        respond (Wai.responseBuilder (toEnum 400) [] mempty)
+    Just (Just value) ->
+      case parseQueryParam (Text.decodeUtf8 value) of
+        Left _err ->
+          respond (Wai.responseBuilder (toEnum 400) [] mempty)
+        Right x ->
+          withParam (Just x) request respond
+{-# INLINEABLE optionalQueryParameter #-}
+
+optionalHeader ::
+  FromHttpApiData a =>
+  HeaderName ->
+  (Maybe a -> Wai.Application) ->
+  Wai.Application
+optionalHeader name withHeader = \request respond ->
+  case List.lookup name (Wai.requestHeaders request) of
+    Nothing ->
+      withHeader Nothing request respond
+    Just value ->
+      case parseHeader value of
+        Left _err ->
+          respond (Wai.responseBuilder (toEnum 400) [] mempty)
+        Right x ->
+          withHeader (Just x) request respond
+{-# INLINEABLE optionalHeader #-}
+
+requiredHeader ::
+  FromHttpApiData a =>
+  HeaderName ->
+  (a -> Wai.Application) ->
+  Wai.Application
+requiredHeader name withHeader = \request respond ->
+  case List.lookup name (Wai.requestHeaders request) of
+    Nothing ->
+      respond (Wai.responseBuilder (toEnum 400) [] mempty)
+    Just value ->
+      case parseHeader value of
+        Left _err ->
+          respond (Wai.responseBuilder (toEnum 400) [] mempty)
+        Right x ->
+          withHeader x request respond
+{-# INLINEABLE requiredHeader #-}
+
+data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
+
+jsonBodyParser :: FromJSON a => BodyParser a
+jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
+{-# INLINE jsonBodyParser #-}
+
+formBodyParser :: FromForm a => BodyParser a
+formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
+{-# INLINE formBodyParser #-}
+
+parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
+parseRequestBody parsers withBody = \request respond -> do
+  let contentType =
+        fromMaybe
+          "text/html"
+          (List.lookup hContentType (Wai.requestHeaders request))
+
+      bodyParser =
+        List.find
+          (\(BodyParser expectedContentType _) -> expectedContentType == contentType)
+          parsers
+
+  case bodyParser of
+    Just (BodyParser _ parseBody) ->
+      parseBody withBody request respond
+    Nothing ->
+      respond (Wai.responseBuilder (toEnum 415) [] mempty)
+{-# INLINE parseRequestBody #-}
+
+parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application
+parseRequestBodyJSON withBody = \request respond -> do
+  result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
+  case eitherResult result of
+    Left _err ->
+      respond (Wai.responseBuilder (toEnum 400) [] mempty)
+    Right value ->
+      case Data.Aeson.Types.parseEither Data.Aeson.parseJSON value of
+        Left _err ->
+          respond (Wai.responseBuilder (toEnum 400) [] mempty)
+        Right body ->
+          withBody body request respond
+{-# INLINEABLE parseRequestBodyJSON #-}
+
+parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application
+parseRequestBodyForm withBody = \request respond -> do
+  -- Reads the body using lazy IO. Not great but it gets us
+  -- going and is pretty local.
+  let getBodyBytes :: IO [ByteString]
+      getBodyBytes = do
+        chunk <- Wai.getRequestBodyChunk request
+        case chunk of
+          "" -> pure []
+          _ -> do
+            rest <- unsafeInterleaveIO getBodyBytes
+            pure (chunk : rest)
+
+  bytes <- getBodyBytes
+  case urlDecodeAsForm (LBS.fromChunks bytes) of
+    Left _err ->
+      respond (Wai.responseBuilder (toEnum 400) [] mempty)
+    Right form ->
+      withBody form request respond
+{-# INLINEABLE parseRequestBodyForm #-}
+
+---------------------
+Test/Response.hs
+
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+module Test.Response where
+
+import qualified Control.Applicative
+import qualified Control.Exception
+import qualified Control.Monad
+import qualified Control.Monad.Catch
+import qualified Control.Monad.IO.Class
+import qualified Data.Aeson
+import qualified Data.Aeson.Encoding
+import qualified Data.Aeson.Parser
+import qualified Data.Aeson.Types
+import qualified Data.Attoparsec.ByteString
+import qualified Data.List
+import qualified Data.Maybe
+import qualified Data.Text
+import qualified Data.Time
+import qualified Data.Text.Encoding
+import qualified GHC.Float
+import qualified GHC.Int
+import qualified GHC.Types
+import qualified Network.HTTP.Types
+import qualified Network.Wai
+import qualified Web.HttpApiData
+
+class ToResponse a where
+    toResponse :: a -> Network.Wai.Response
+---------------------
+Test/Response/Test.hs
+
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+module Test.Response.Test where
+
+import qualified Control.Applicative
+import qualified Control.Exception
+import qualified Control.Monad
+import qualified Control.Monad.Catch
+import qualified Control.Monad.IO.Class
+import qualified Data.Aeson
+import qualified Data.Aeson.Encoding
+import qualified Data.Aeson.Parser
+import qualified Data.Aeson.Types
+import qualified Data.Attoparsec.ByteString
+import qualified Data.List
+import qualified Data.Maybe
+import qualified Data.Text
+import qualified Data.Time
+import qualified Data.Text.Encoding
+import qualified GHC.Float
+import qualified GHC.Int
+import qualified GHC.Types
+import qualified Network.HTTP.Types
+import qualified Network.Wai
+import qualified Web.HttpApiData
+
+
+
+import Test.Response
+
+type TestResponseBody200 = Data.Aeson.Value
+
+data TestResponse
+    = TestResponse200 [ TestResponseBody200 ]
+    deriving (Show)
+
+instance Control.Exception.Exception TestResponse
+
+instance ToResponse TestResponse where
+    toResponse (TestResponse200 x) =
+        Network.Wai.responseBuilder (toEnum 200) ([(Network.HTTP.Types.hContentType, "application/json")]) (Data.Aeson.fromEncoding (Data.Aeson.toEncoding x))
+---------------------
+test.cabal
+
+cabal-version: 3.0
+name: test
+version: 0.1.0.0
+library
+  build-depends:
+    , aeson
+    , attoparsec
+    , base
+    , bytestring
+    , exceptions
+    , ghc-prim
+    , http-api-data
+    , http-types
+    , text
+    , time
+    , wai
+  exposed-modules:
+    Test.Api
+    Test.Request
+    Test.Response
+    Test.Response.Test