Support parameter annotations for generated constructors, simplify ne…

…sted annotations

src/Compiler/Jvm/Asm.idr

@@ -613,10 +613,14 @@ getAnnotationValues : AnnotationValue -> List Annotation
 getAnnotationValues (AnnArray values) = mapMaybe getAnnotationValue values
 getAnnotationValues _ = []
 
+export
+getParameterAnnotationValues : AnnotationValue -> List (List Annotation)
+getParameterAnnotationValues (AnnArray values) = getAnnotationValues <$> values
+getParameterAnnotationValues _ = []
+
 export
 getAnnotationProperties : Annotation -> List AnnotationProperty
 getAnnotationProperties (MkAnnotation _ props) = props
-getAnnotationProperties _ = []
 
 public export
 data Asm : Type -> Type where

src/Compiler/Jvm/Codegen.idr

@@ -2161,8 +2161,8 @@ generateSetters descriptorsByEncloser classExport =
   generateAccessors descriptorsByEncloser classExport (createSetter classExport)
 
 generateConstructor : SortedMap ClassExport (List ExportDescriptor) -> ClassExport ->
-                        List FieldExport -> List Annotation -> Asm ()
-generateConstructor descriptorsByEncloser classExport fields annotations = do
+                        List FieldExport -> List Annotation -> List (List Annotation) -> Asm ()
+generateConstructor descriptorsByEncloser classExport fields annotations parameterAnnotations = do
   let fieldTypes = FieldExport.type <$> fields
   let descriptor = getMethodDescriptor $ MkInferredFunctionType IVoid fieldTypes
   let signature = Just $ getMethodSignature $ MkInferredFunctionType IVoid fieldTypes
@@ -2171,7 +2171,9 @@ generateConstructor descriptorsByEncloser classExport fields annotations = do
   let arity = the Int $ cast $ length fields
   jvmArgumentTypesByIndex <- LiftIo $ Map.fromList $ zip [0 .. arity] (classType :: fieldTypes)
   let asmAnnotations = asmAnnotation <$> annotations
-  CreateMethod [Public] "generated.idr" classExport.name "<init>" descriptor signature Nothing asmAnnotations []
+  let asmParameterAnnotations = (\annotations => asmAnnotation <$> annotations) <$> parameterAnnotations
+  CreateMethod [Public] "generated.idr" classExport.name "<init>" descriptor signature Nothing asmAnnotations
+    asmParameterAnnotations
   MethodCodeStart
   CreateLabel methodStartLabel
   CreateLabel methodEndLabel
@@ -2204,15 +2206,19 @@ generateConstructor descriptorsByEncloser classExport fields annotations = do
     let fieldType = field.type
     LocalVariable field.name (getJvmTypeDescriptor fieldType) Nothing methodStartLabel methodEndLabel index
 
+getMatchingAnnotationProperty : String -> List AnnotationProperty -> Maybe AnnotationValue
+getMatchingAnnotationProperty name props = snd <$> find (\(currentName, value) => name == currentName) props
+
 generateRequiredArgsConstructor : SortedMap ClassExport (List ExportDescriptor) -> ClassExport ->
                                     List AnnotationProperty -> Asm ()
 generateRequiredArgsConstructor descriptorsByEncloser classExport props = do
   let allFields = getFields $ fromMaybe [] $ SortedMap.lookup classExport descriptorsByEncloser
   let requiredFields@(_ :: _) = filter isRequiredField allFields
         | [] => Pure ()
-  let annotations = getAnnotationValues $ snd $ fromMaybe ("annotations", AnnArray []) $
-                        (find (\(name, value) => name == "annotations") props)
-  generateConstructor descriptorsByEncloser classExport requiredFields annotations
+  let annotations = getAnnotationValues $ fromMaybe (AnnArray []) $ getMatchingAnnotationProperty "annotations" props
+  let parameterAnnotations = getParameterAnnotationValues $ fromMaybe (AnnArray []) $
+                               getMatchingAnnotationProperty "parameterAnnotations" props
+  generateConstructor descriptorsByEncloser classExport requiredFields annotations parameterAnnotations
 
 generateAllArgsConstructor : SortedMap ClassExport (List ExportDescriptor) -> ClassExport -> Asm ()
 generateAllArgsConstructor descriptorsByEncloser classExport = do
@@ -2222,9 +2228,10 @@ generateAllArgsConstructor descriptorsByEncloser classExport = do
   let excludedFields = getStringAnnotationValues $ snd $ fromMaybe ("exclude", AnnArray []) $
                         (find (\(name, value) => name == "exclude") props)
   let constructorFields = filter (\fieldExport => not $ elem fieldExport.name excludedFields) fields
-  let annotations = getAnnotationValues $ snd $ fromMaybe ("annotations", AnnArray []) $
-                      (find (\(name, value) => name == "annotations") props)
-  generateConstructor descriptorsByEncloser classExport constructorFields annotations
+  let annotations = getAnnotationValues $ fromMaybe (AnnArray []) $ getMatchingAnnotationProperty "annotations" props
+  let parameterAnnotations = getParameterAnnotationValues $ fromMaybe (AnnArray []) $
+                               getMatchingAnnotationProperty "parameterAnnotations" props
+  generateConstructor descriptorsByEncloser classExport constructorFields annotations parameterAnnotations
 
 generateNoArgsConstructor : SortedMap ClassExport (List ExportDescriptor) -> ClassExport -> Asm ()
 generateNoArgsConstructor descriptorsByEncloser classExport = do

src/Compiler/Jvm/Export.idr

@@ -46,20 +46,19 @@ mutual
       | _ => asmCrash ("Expected 'string' enum value for annotation " ++ show annotationName ++ " in " ++
                show functionName)
     Pure $ AnnEnum type value
-  parseAnnotationTypeValue functionName annotationName "annotation" annotationJson = do
-    annotation <- parseAnnotation functionName annotationJson
-    Pure $ AnnAnnotation annotation
+  parseAnnotationTypeValue functionName annotationName "annotation" annotationJson =
+    AnnAnnotation <$> parseAnnotation functionName annotationJson
   parseAnnotationTypeValue functionName annotationName type _ =
     asmCrash ("Unknown type " ++ show type ++ " for annotation " ++ annotationName ++ " in " ++ show functionName)
 
   parseAnnotationValue : Name -> String -> JSON -> Asm AnnotationValue
   parseAnnotationValue functionName annotationName (JNumber value) = Pure $ AnnInt $ cast value
   parseAnnotationValue functionName annotationName (JString value) = Pure $ AnnString value
   parseAnnotationValue functionName annotationName (JBoolean value) = Pure $ AnnBoolean value
-  parseAnnotationValue functionName annotationName (JObject properties) = do
+  parseAnnotationValue functionName annotationName annotationJson@(JObject properties) = do
     let propertiesByName = SortedMap.fromList properties
     let Just (JString type) = lookup "type" propertiesByName
-      | _ => asmCrash ("Missing 'string' type for annotation " ++ annotationName ++ " in " ++ show functionName)
+      | _ => AnnAnnotation <$> parseAnnotation functionName annotationJson
     let Just value = SortedMap.lookup "value" propertiesByName
       | _ => asmCrash ("Missing 'string' value for annotation " ++ annotationName ++ " in " ++ show functionName)
     parseAnnotationTypeValue functionName annotationName type value