Skip to content

Commit

Permalink
CodeGen: minLength >= 1 emits NonEmpty
Browse files Browse the repository at this point in the history
  • Loading branch information
ysangkok committed Apr 18, 2024
1 parent 94fa13d commit d1b92cb
Show file tree
Hide file tree
Showing 8 changed files with 86 additions and 11 deletions.
37 changes: 27 additions & 10 deletions json-fleece-codegen-util/src/Fleece/CodeGenUtil.hs
Original file line number Diff line number Diff line change
Expand Up @@ -242,7 +242,7 @@ data CodeGenDataFormat
= CodeGenNewType TypeOptions SchemaTypeInfoOrRef
| CodeGenEnum TypeOptions [T.Text]
| CodeGenObject TypeOptions [CodeGenObjectField] (Maybe CodeGenAdditionalProperties)
| CodeGenArray TypeOptions CodeGenRefType
| CodeGenArray TypeOptions (Maybe Integer) CodeGenRefType
| CodeGenUnion [CodeGenUnionMember]

codeGenNewTypeSchemaTypeInfo :: TypeOptions -> SchemaTypeInfo -> CodeGenDataFormat
Expand Down Expand Up @@ -447,6 +447,18 @@ arrayTypeInfo itemInfo =
<> ")"
}

nonEmptyTypeInfo :: SchemaTypeInfo -> SchemaTypeInfo
nonEmptyTypeInfo itemInfo =
itemInfo
{ schemaTypeExpr = HC.nonEmptyOf (schemaTypeExpr itemInfo)
, schemaTypeSchema =
"("
<> fleeceCoreVar "nonEmpty"
<> " "
<> schemaTypeSchema itemInfo
<> ")"
}

mapTypeInfo :: SchemaTypeInfo -> SchemaTypeInfo
mapTypeInfo itemInfo =
itemInfo
Expand Down Expand Up @@ -814,7 +826,7 @@ mkParameterCollectionCode moduleName typeName schemaName params = do
AtMostOne -> HC.maybeOf paramTypeName
AtLeastZero -> HC.listOf paramTypeName
AtLeastOne ->
HC.typeNameToCodeDefaultQualification nonEmptyType
HC.typeNameToCodeDefaultQualification HC.nonEmptyType
<> " "
<> paramTypeName

Expand Down Expand Up @@ -1092,8 +1104,8 @@ generateCodeGenDataFormat typeMap typeName format = do
pure $ generateFleeceEnum typeName values typeOptions
CodeGenObject typeOptions fields mbAdditionalProperties ->
generateFleeceObject typeMap typeName fields mbAdditionalProperties typeOptions
CodeGenArray typeOptions itemType ->
generateFleeceArray typeMap typeName itemType typeOptions
CodeGenArray typeOptions mbMinLength itemType ->
generateFleeceArray typeMap typeName mbMinLength itemType typeOptions
CodeGenUnion members ->
generateFleeceUnion typeMap typeName members

Expand Down Expand Up @@ -1446,11 +1458,20 @@ generateFleeceObject typeMap typeName codeGenFields mbAdditionalProperties typeO
generateFleeceArray ::
CodeGenMap ->
HC.TypeName ->
Maybe Integer ->
CodeGenRefType ->
TypeOptions ->
CodeGen ([HC.VarName], HC.HaskellCode)
generateFleeceArray typeMap typeName itemType typeOptions = do
typeInfo <- fmap arrayTypeInfo (resolveRefTypeInfo typeMap itemType)
generateFleeceArray typeMap typeName mbMinLength itemType typeOptions = do
let
elemTypeInfo =
case mbMinLength of
Just minLength
| minLength >= 1 ->
nonEmptyTypeInfo
_ ->
arrayTypeInfo
typeInfo <- fmap elemTypeInfo (resolveRefTypeInfo typeMap itemType)
generateFleeceNewtype
typeMap
typeName
Expand Down Expand Up @@ -1699,10 +1720,6 @@ boolType :: HC.TypeName
boolType =
HC.preludeType "Bool"

nonEmptyType :: HC.TypeName
nonEmptyType =
HC.toTypeName "Data.List.NonEmpty" (Just "NEL") "NonEmpty"

fleeceClass :: HC.TypeName
fleeceClass =
fleeceCoreType "Fleece"
Expand Down
14 changes: 14 additions & 0 deletions json-fleece-codegen-util/src/Fleece/CodeGenUtil/HaskellCode.hs
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@ module Fleece.CodeGenUtil.HaskellCode
, toVarName
, toConstructorVarName
, listOf
, nonEmptyOf
, mapOf
, maybeOf
, eitherOf
Expand All @@ -66,6 +67,7 @@ module Fleece.CodeGenUtil.HaskellCode
, boundedClass
, preludeType
, shrubberyType
, nonEmptyType
) where

-- import prelude explicitly since we want to define our own 'lines' function
Expand Down Expand Up @@ -417,6 +419,18 @@ listOf :: TypeExpression -> TypeExpression
listOf itemName =
TypeExpression ("[" <> toCode itemName <> "]")

nonEmptyType :: TypeName
nonEmptyType =
toTypeName "Data.List.NonEmpty" (Just "NEL") "NonEmpty"

nonEmptyOf :: TypeExpression -> TypeExpression
nonEmptyOf itemName =
"("
<> typeNameToCodeDefaultQualification nonEmptyType
<> " "
<> itemName
<> ")"

mapType :: TypeName
mapType =
toTypeName "Data.Map" (Just "Map") "Map"
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,18 @@
{-# LANGUAGE NoImplicitPrelude #-}

module TestCases.Types.MinLengthOne
( MinLengthOne(..)
, minLengthOneSchema
) where

import qualified Data.List.NonEmpty as NEL
import qualified Fleece.Core as FC
import Prelude (Eq, Show)
import qualified TestCases.Types.MinLengthOne.MinLengthOneItem as MinLengthOneItem

newtype MinLengthOne = MinLengthOne (NEL.NonEmpty MinLengthOneItem.MinLengthOneItem)
deriving (Show, Eq)

minLengthOneSchema :: FC.Fleece schema => schema MinLengthOne
minLengthOneSchema =
FC.coerceSchema (FC.nonEmpty MinLengthOneItem.minLengthOneItemSchema)
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
{-# LANGUAGE NoImplicitPrelude #-}

module TestCases.Types.MinLengthOne.MinLengthOneItem
( MinLengthOneItem(..)
, minLengthOneItemSchema
) where

import qualified Fleece.Core as FC
import Prelude (Bool, Eq, Show)

newtype MinLengthOneItem = MinLengthOneItem Bool
deriving (Show, Eq)

minLengthOneItemSchema :: FC.Fleece schema => schema MinLengthOneItem
minLengthOneItemSchema =
FC.coerceSchema FC.boolean
2 changes: 2 additions & 0 deletions json-fleece-openapi3/examples/test-cases/test-cases.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,8 @@ library
TestCases.Types.JustAdditionalPropertiesSchemaRef
TestCases.Types.JustAdditionalPropertiesTrue
TestCases.Types.LocalTimeType
TestCases.Types.MinLengthOne
TestCases.Types.MinLengthOne.MinLengthOneItem
TestCases.Types.MixedInAdditionalPropertiesFalse
TestCases.Types.MixedInAdditionalPropertiesFalse.Bar
TestCases.Types.MixedInAdditionalPropertiesFalse.Foo
Expand Down
6 changes: 6 additions & 0 deletions json-fleece-openapi3/examples/test-cases/test-cases.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -764,3 +764,9 @@ components:
AStringType:
description: An explicit type that is just a string for use in other test cases
type: string

MinLengthOne:
type: array
items:
type: boolean
minLength: 1
2 changes: 2 additions & 0 deletions json-fleece-openapi3/json-fleece-openapi3.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -1953,6 +1953,8 @@ extra-source-files:
examples/test-cases/TestCases/Types/JustAdditionalPropertiesSchemaRef.hs
examples/test-cases/TestCases/Types/JustAdditionalPropertiesTrue.hs
examples/test-cases/TestCases/Types/LocalTimeType.hs
examples/test-cases/TestCases/Types/MinLengthOne.hs
examples/test-cases/TestCases/Types/MinLengthOne/MinLengthOneItem.hs
examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesFalse.hs
examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesFalse/Bar.hs
examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesFalse/Foo.hs
Expand Down
2 changes: 1 addition & 1 deletion json-fleece-openapi3/src/Fleece/OpenApi3.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1148,7 +1148,7 @@ mkOpenApiArrayFormat ::
CGU.CodeGen (SchemaMap, CGU.CodeGenDataFormat)
mkOpenApiArrayFormat schemaKey typeName schema = do
typeOptions <- CGU.lookupTypeOptions typeName
fmap (fmap (CGU.CodeGenArray typeOptions)) $
fmap (fmap (CGU.CodeGenArray typeOptions (OA._schemaMinLength schema))) $
schemaArrayItemsToFieldType
CGU.Type
schemaKey
Expand Down

0 comments on commit d1b92cb

Please sign in to comment.