Merge pull request #33 from flipstone/min-length-makes-non-empty

CodeGen: minLength >= 1 emits NonEmpty

json-fleece-codegen-util/src/Fleece/CodeGenUtil.hs

@@ -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
@@ -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
@@ -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
 
@@ -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
 
@@ -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
@@ -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"

json-fleece-codegen-util/src/Fleece/CodeGenUtil/HaskellCode.hs

@@ -44,6 +44,7 @@ module Fleece.CodeGenUtil.HaskellCode
   , toVarName
   , toConstructorVarName
   , listOf
+  , nonEmptyOf
   , mapOf
   , maybeOf
   , eitherOf
@@ -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
@@ -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"

json-fleece-openapi3/examples/test-cases/TestCases/Types/MinLengthOne.hs

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

json-fleece-openapi3/examples/test-cases/TestCases/Types/MinLengthOne/MinLengthOneItem.hs

@@ -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

json-fleece-openapi3/examples/test-cases/test-cases.cabal

@@ -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

json-fleece-openapi3/examples/test-cases/test-cases.yaml

@@ -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

json-fleece-openapi3/json-fleece-openapi3.cabal

@@ -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

json-fleece-openapi3/src/Fleece/OpenApi3.hs

@@ -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