transform api member comment to start newlines (#60)

this change transforms the api member comments to start a newline
and render multi line comments.

shell.nix

@@ -9,5 +9,6 @@ pkgs.mkShell {
     ghc
     cabal-install
     ghcid
+    ormolu
   ];
 }

src/Tie/Codegen/Operation.hs

@@ -9,6 +9,7 @@ module Tie.Codegen.Operation
 where
 
 import qualified Data.Map.Strict as Map
+import qualified Debug.Trace
 import Prettyprinter (Doc, (<+>))
 import qualified Prettyprinter as PP
 import qualified Prettyprinter.Render.Text as PP
@@ -185,7 +186,18 @@ codegenApiTypeOperation resolver Operation {..} = do
       Nothing ->
         "--" <+> "@" <> toParamName name <> "@" <> PP.line
       Just comment ->
-        "--" <+> "@" <> toParamName name <> "@" <+> PP.pretty comment <> PP.line
+        "--"
+          <+> "@"
+          <> toParamName name
+          <> "@"
+          <> PP.line
+          <> codegenMultilineComment comment
+          <> PP.line
+
+    codegenMultilineComment :: Text -> Doc ann
+    codegenMultilineComment commentLines =
+      let comments = fmap ("-- " <>) $ lines commentLines
+       in PP.cat (fmap PP.pretty comments)
 
     codegenRequestBodyComment RequestBody {description} = case description of
       Nothing ->

test/golden/description.yaml

@@ -0,0 +1,47 @@
+openapi: "3.0.0"
+info:
+  version: 1.0.0
+  title: Scarf
+  license:
+    name: AllRightsReserved
+servers:
+  - url: https://scarf.sh/api/v1
+paths:
+  /test:
+    parameters:
+      - name: package_query
+        in: query
+        required: false
+        description: >
+          Use this query parameter to filter for the packages thats suits your use case.
+          It can be used by passing in either package names or package ids. 
+          To query for multiple packages you can pass in comma separated values.
+          For example:
+
+          ```
+
+          package_query=17ea97c0-d350-45ce-9f36-ebb66694196c,558664cd-fece-47f5-a9ca-f30974cf96a5,...
+
+          ```
+
+          Or if you prefer using package names, you can also pass in 
+
+          ```
+
+          package_query=package_name_1,package_name_2...
+
+          ```
+        schema:
+          type: string
+    get:
+      summary: test
+      operationId: test
+      responses:
+        '200':
+          description: CSV response without schema
+          content:
+            application/json: 
+              schema:
+                description: Undocumented
+                type: array
+components: {}

test/golden/description.yaml.out

@@ -0,0 +1,512 @@
+Test/Api.hs
+
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Test.Api where
+
+import qualified Control.Applicative
+import qualified Control.Exception
+import qualified Control.Monad
+import qualified Control.Monad.IO.Class
+import qualified Data.Aeson
+import qualified Data.Aeson.Encoding
+import qualified Data.Aeson.Types
+import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
+import qualified Data.List
+import qualified Data.List.NonEmpty
+import qualified Data.Map
+import qualified Data.Maybe
+import qualified Data.Text
+import qualified Data.Text.Encoding
+import qualified Data.Time
+import qualified GHC.Float
+import qualified GHC.Int
+import qualified GHC.Records
+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 ::
+        -- @package_query@
+        -- Use this query parameter to filter for the packages thats suits your use case. It can be used by passing in either package names or package ids.  To query for multiple packages you can pass in comma separated values. For example:
+        -- ```
+        -- package_query=17ea97c0-d350-45ce-9f36-ebb66694196c,558664cd-fece-47f5-a9ca-f30974cf96a5,...
+        -- ```
+        -- Or if you prefer using package names, you can also pass in 
+        -- ```
+        -- package_query=package_name_1,package_name_2...
+        -- ```
+        (Data.Maybe.Maybe (Data.Text.Text)) ->
+        m TestResponse
+}
+
+application :: (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" ->
+                    optionalQueryParameter "package_query" False (\__package_query request respond ->
+                        run request (do
+                            response <- test api __package_query
+                            Control.Monad.IO.Class.liftIO (respond $! (toResponse response))
+                        )) request respond
+                x ->
+                    unsupportedMethod x
+
+        _ ->
+            notFound request respond
+    where
+        unsupportedMethod _ =
+            respond (Network.Wai.responseBuilder Network.HTTP.Types.status405 [] mempty)
+{-# INLINABLE application #-}
+---------------------
+Test/Request.hs
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Test.Request
+  ( -- * Parameters
+    Style (..),
+    pathVariable,
+    requiredQueryParameter,
+    requiredQueryParameters,
+    optionalQueryParameter,
+    optionalQueryParameters,
+    requiredHeader,
+    optionalHeader,
+
+    -- * Request body
+    parseRequestBody,
+    jsonBodyParser,
+    formBodyParser,
+  )
+where
+
+import qualified Data.Aeson
+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.Builder as Builder
+import qualified Data.ByteString.Lazy as LBS
+import Data.Coerce (coerce)
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.List as List
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+import qualified Network.HTTP.Media
+import Network.HTTP.Types (HeaderName, hContentType)
+import qualified Network.Wai as Wai
+import System.IO.Unsafe (unsafeInterleaveIO)
+import Web.FormUrlEncoded
+  ( FromForm,
+    parseAll,
+    urlDecodeAsForm,
+    urlDecodeForm,
+  )
+import Web.HttpApiData
+  ( FromHttpApiData,
+    parseHeader,
+    parseQueryParam,
+    parseUrlPiece,
+    parseUrlPieces,
+  )
+
+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 #-}
+
+data Style
+  = FormStyle
+  | CommaDelimitedStyle
+  | SpaceDelimitedStyle
+  | PipeDelimitedStyle
+
+newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
+
+instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
+  parseUrlPiece input = do
+    xs <- parseUrlPieces (Text.splitOn "," input)
+    pure (CommaDelimitedValue xs)
+
+newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
+
+instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
+  parseUrlPiece input = do
+    xs <- parseUrlPieces (Text.splitOn " " input)
+    pure (SpaceDelimitedValue xs)
+
+newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
+
+instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
+  parseUrlPiece input = do
+    xs <- parseUrlPieces (Text.splitOn "|" input)
+    pure (PipeDelimitedValue xs)
+
+requiredQueryParameters ::
+  (FromHttpApiData a) =>
+  Style ->
+  ByteString ->
+  (NonEmpty.NonEmpty a -> Wai.Application) ->
+  Wai.Application
+requiredQueryParameters style name withParam =
+  case style of
+    FormStyle -> \request respond ->
+      case urlDecodeForm (LBS.fromStrict (ByteString.drop 1 (Wai.rawQueryString request))) of
+        Left error ->
+          respond (Wai.responseBuilder (toEnum 400) [] mempty)
+        Right form ->
+          case parseAll (Text.decodeUtf8 name) form of
+            Left _ ->
+              respond (Wai.responseBuilder (toEnum 400) [] mempty)
+            Right [] ->
+              respond (Wai.responseBuilder (toEnum 400) [] mempty)
+            Right (x : xs) ->
+              withParam (x NonEmpty.:| xs) request respond
+    SpaceDelimitedStyle ->
+      requiredQueryParameter
+        name
+        ( \xs -> \request respond ->
+            case NonEmpty.nonEmpty (unSpaceDelimitedValue xs) of
+              Nothing ->
+                respond (Wai.responseBuilder (toEnum 400) [] mempty)
+              Just xs ->
+                withParam xs request respond
+        )
+    PipeDelimitedStyle ->
+      requiredQueryParameter
+        name
+        ( \xs -> \request respond ->
+            case NonEmpty.nonEmpty (unPipeDelimitedValue xs) of
+              Nothing ->
+                respond (Wai.responseBuilder (toEnum 400) [] mempty)
+              Just xs ->
+                withParam xs request respond
+        )
+    CommaDelimitedStyle ->
+      requiredQueryParameter
+        name
+        ( \xs -> \request respond ->
+            case NonEmpty.nonEmpty (unCommaDelimitedValue xs) of
+              Nothing ->
+                respond (Wai.responseBuilder (toEnum 400) [] mempty)
+              Just xs ->
+                withParam xs request respond
+        )
+
+optionalQueryParameters ::
+  (FromHttpApiData a) =>
+  Style ->
+  ByteString ->
+  (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
+  Wai.Application
+optionalQueryParameters style name withParam =
+  case style of
+    FormStyle -> \request respond ->
+      case urlDecodeForm (LBS.fromStrict (ByteString.drop 1 (Wai.rawQueryString request))) of
+        Left error ->
+          respond (Wai.responseBuilder (toEnum 400) [] mempty)
+        Right form ->
+          case parseAll (Text.decodeUtf8 name) form of
+            Left _ ->
+              respond (Wai.responseBuilder (toEnum 400) [] mempty)
+            Right [] ->
+              withParam Nothing request respond
+            Right (x : xs) ->
+              withParam (Just (x NonEmpty.:| xs)) request respond
+    SpaceDelimitedStyle ->
+      optionalQueryParameter
+        name
+        False
+        ( \xs ->
+            withParam (xs >>= NonEmpty.nonEmpty . unSpaceDelimitedValue)
+        )
+    PipeDelimitedStyle ->
+      optionalQueryParameter
+        name
+        False
+        ( \xs ->
+            withParam (xs >>= NonEmpty.nonEmpty . unPipeDelimitedValue)
+        )
+    CommaDelimitedStyle ->
+      optionalQueryParameter
+        name
+        False
+        ( \xs ->
+            withParam (xs >>= NonEmpty.nonEmpty . unCommaDelimitedValue)
+        )
+
+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) [] ("Missing query parameter: " <> Builder.byteString name))
+    Just Nothing ->
+      respond (Wai.responseBuilder (toEnum 400) [] ("Missing query parameter: " <> Builder.byteString name))
+    Just (Just value) ->
+      case parseQueryParam (Text.decodeUtf8 value) of
+        Left _err ->
+          respond (Wai.responseBuilder (toEnum 400) [] ("Unable to recognize query parameter: " <> Builder.byteString name))
+        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) [] ("Missing query parameter: " <> Builder.byteString name))
+    Just (Just value) ->
+      case parseQueryParam (Text.decodeUtf8 value) of
+        Left _err ->
+          respond (Wai.responseBuilder (toEnum 400) [] ("Unable to recognize query parameter: " <> Builder.byteString name))
+        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
+      Network.HTTP.Media.MediaType
+      ((a -> Wai.Application) -> Wai.Application)
+
+jsonBodyParser :: (Data.Aeson.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
+          "application/octet-stream"
+          (List.lookup hContentType (Wai.requestHeaders request))
+
+      bodyParser =
+        Network.HTTP.Media.mapAccept
+          [(mediaType, parser) | BodyParser mediaType parser <- parsers]
+          contentType
+
+  case bodyParser of
+    Just parseBody ->
+      parseBody withBody request respond
+    Nothing ->
+      respond (Wai.responseBuilder (toEnum 415) [] mempty)
+{-# INLINE parseRequestBody #-}
+
+parseRequestBodyJSON :: (Data.Aeson.FromJSON a) => (a -> Wai.Application) -> Wai.Application
+parseRequestBodyJSON withBody = \request respond -> do
+  body <- Wai.lazyRequestBody request
+  case Data.Aeson.decode' body of
+    Nothing ->
+      respond (Wai.responseBuilder (toEnum 400) [] mempty)
+    Just body ->
+      withBody body request respond
+{-# INLINEABLE parseRequestBodyJSON #-}
+
+parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
+parseRequestBodyForm withBody = \request respond -> do
+  body <- Wai.lazyRequestBody request
+  case urlDecodeAsForm body of
+    Left _err ->
+      respond (Wai.responseBuilder (toEnum 400) [] mempty)
+    Right form ->
+      withBody form request respond
+{-# INLINEABLE parseRequestBodyForm #-}
+
+---------------------
+Test/Response.hs
+
+module Test.Response
+  ( ToResponse (..),
+
+    -- * NDJSON support
+    NDJSON,
+    responseNDJSON,
+  )
+where
+
+import qualified Data.Aeson
+import qualified Data.Aeson.Encoding
+import qualified Data.ByteString.Builder
+import qualified Network.HTTP.Types
+import qualified Network.Wai
+
+type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
+
+responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
+responseNDJSON status responseHeaders stream =
+  Network.Wai.responseStream status responseHeaders $ \emit flush ->
+    stream
+      ( \element ->
+          emit
+            ( Data.Aeson.Encoding.fromEncoding (Data.Aeson.toEncoding element)
+                <> Data.ByteString.Builder.char7 '\n'
+            )
+      )
+      flush
+
+class ToResponse a where
+  toResponse :: a -> Network.Wai.Response
+
+---------------------
+Test/Response/Test.hs
+
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Test.Response.Test where
+
+import qualified Control.Applicative
+import qualified Control.Exception
+import qualified Control.Monad
+import qualified Control.Monad.IO.Class
+import qualified Data.Aeson
+import qualified Data.Aeson.Encoding
+import qualified Data.Aeson.Types
+import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
+import qualified Data.List
+import qualified Data.List.NonEmpty
+import qualified Data.Map
+import qualified Data.Maybe
+import qualified Data.Text
+import qualified Data.Text.Encoding
+import qualified Data.Time
+import qualified GHC.Float
+import qualified GHC.Int
+import qualified GHC.Records
+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 ToResponse TestResponse where
+    toResponse (TestResponse200 x) =
+        Network.Wai.responseBuilder Network.HTTP.Types.status200 ([(Network.HTTP.Types.hContentType, "application/json")]) (Data.Aeson.fromEncoding (Data.Aeson.toEncoding x))
+
+instance GHC.Records.HasField "status" TestResponse Network.HTTP.Types.Status where
+    getField (TestResponse200 {}) = Network.HTTP.Types.status200
+---------------------
+test.cabal
+
+cabal-version: 3.0
+name: test
+version: 0.1.0.0
+library
+  build-depends:
+    , aeson
+    , attoparsec
+    , base
+    , bytestring
+    , containers
+    , ghc-prim
+    , http-api-data
+    , http-media
+    , http-types
+    , text
+    , time
+    , unordered-containers
+    , wai
+  exposed-modules:
+    Test.Api
+    Test.Request
+    Test.Response
+    Test.Response.Test

test/golden/headers.yaml.out

@@ -47,7 +47,8 @@ import Test.Response.Test2
 data Api m = Api {
     -- | test
     test ::
-        -- @x-next@ How many items to return at one time (max 100)
+        -- @x-next@
+        -- How many items to return at one time (max 100)
         (Data.Maybe.Maybe (GHC.Int.Int32)) ->
         m TestResponse,
     -- | test

test/golden/petstore.yaml.out

@@ -52,12 +52,14 @@ data Api m = Api {
         m CreatePetsResponse,
     -- | List all pets
     listPets ::
-        -- @limit@ How many items to return at one time (max 100)
+        -- @limit@
+        -- How many items to return at one time (max 100)
         (Data.Maybe.Maybe (GHC.Int.Int32)) ->
         m ListPetsResponse,
     -- | Info for a specific pet
     showPetById ::
-        -- @petId@ The id of the pet to retrieve
+        -- @petId@
+        -- The id of the pet to retrieve
         Data.Text.Text ->
         m ShowPetByIdResponse
 }

test/golden/test1.yaml.out

@@ -47,9 +47,11 @@ import Test.Response.GetUser
 data Api m = Api {
     -- | Adds a new user
     createUser ::
-        -- @id@ Uniquely identifies a user
+        -- @id@
+        -- Uniquely identifies a user
         GHC.Int.Int ->
-        -- @name@ Name of a user
+        -- @name@
+        -- Name of a user
         Data.Text.Text ->
         -- @page@
         GHC.Int.Int ->
@@ -59,9 +61,11 @@ data Api m = Api {
         CreateUserRequestBody ->
         m CreateUserResponse,
     getUser ::
-        -- @id@ Uniquely identifies a user
+        -- @id@
+        -- Uniquely identifies a user
         GHC.Int.Int ->
-        -- @name@ Name of a user
+        -- @name@
+        -- Name of a user
         Data.Text.Text ->
         -- @page@
         GHC.Int.Int ->