diff --git a/hydra-java.cabal b/hydra-java.cabal --- a/hydra-java.cabal +++ b/hydra-java.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hydra-java -version: 0.17.2 +version: 0.17.3 synopsis: Hydra's Java coder: emit Java source from Hydra modules description: Hydra is an implementation of the LambdaGraph data model, which takes advantage of an isomorphism between labeled hypergraphs and typed lambda calculus: in Hydra, "graphs are programs, and programs are graphs". Java support for Hydra category: Data @@ -48,7 +48,7 @@ build-depends: base >=4.19.0 && <4.22 , containers >=0.6.7 && <0.8 - , hydra-jvm ==0.17.2 - , hydra-kernel ==0.17.2 + , hydra-jvm ==0.17.3 + , hydra-kernel ==0.17.3 , scientific >=0.3.7 && <0.4 default-language: Haskell2010 diff --git a/src/main/haskell/Hydra/Java/Coder.hs b/src/main/haskell/Hydra/Java/Coder.hs --- a/src/main/haskell/Hydra/Java/Coder.hs +++ b/src/main/haskell/Hydra/Java/Coder.hs @@ -41,6 +41,7 @@ import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings @@ -318,7 +319,7 @@ deps = Pairs.second entry in (key, (Sets.toList deps))) (Maps.toList allDeps)) recursiveVars = - Sets.fromList (Lists.concat (Lists.map (\names -> Logic.ifElse (Equality.equal (Lists.length names) 1) (Optionals.cases (Lists.maybeHead names) [] (\singleName -> Optionals.cases (Maps.lookup singleName allDeps) [] (\deps -> Logic.ifElse (Sets.member singleName deps) [ + Sets.fromList (Lists.concat (Lists.map (\names -> Logic.ifElse (Equality.equal (Lists.length names) 1) (Optionals.cases (Lists.head names) [] (\singleName -> Optionals.cases (Maps.lookup singleName allDeps) [] (\deps -> Logic.ifElse (Sets.member singleName deps) [ singleName] []))) names) sorted)) thunkedVars = Sets.fromList (Lists.concat (Lists.map (\b -> @@ -344,7 +345,7 @@ JavaEnvironment.JavaEnvironment { JavaEnvironment.javaEnvironmentAliases = aliasesExtended, JavaEnvironment.javaEnvironmentGraph = gExtended} - in (Logic.ifElse (Lists.null bindings) (Right ([], envExtended)) (Eithers.bind (Eithers.mapList (\names -> Eithers.bind (Eithers.mapList (\n -> toDeclInit aliasesExtended gExtended recursiveVars flatBindings n cx g) names) (\inits -> Eithers.bind (Eithers.mapList (\n -> toDeclStatement envExtended aliasesExtended gExtended recursiveVars thunkedVars flatBindings n cx g) names) (\decls -> Right (Lists.concat2 (Optionals.cat inits) decls)))) sorted) (\groups -> Right (Lists.concat groups, envExtended)))) + in (Logic.ifElse (Lists.null bindings) (Right ([], envExtended)) (Eithers.bind (Eithers.mapList (\names -> Eithers.bind (Eithers.mapList (\n -> toDeclInit aliasesExtended gExtended recursiveVars flatBindings n cx g) names) (\inits -> Eithers.bind (Eithers.mapList (\n -> toDeclStatement envExtended aliasesExtended gExtended recursiveVars thunkedVars flatBindings n cx g) names) (\decls -> Right (Lists.concat2 (Optionals.givens inits) decls)))) sorted) (\groups -> Right (Lists.concat groups, envExtended)))) boundTypeVariables :: Core.Type -> [Core.Name] boundTypeVariables typ = @@ -490,7 +491,7 @@ builderSetterName fname = let base = Utils.sanitizeJavaName (Core.unName fname) - in (Logic.ifElse (Logic.or (Equality.equal base "build") (Equality.equal base "builder")) (Strings.cat2 base "_") base) + in (Logic.ifElse (Logic.or (Equality.equal base "build") (Equality.equal base "builder")) (Strings.concat2 base "_") base) classModsPublic :: [Syntax.ClassModifier] classModsPublic = [ @@ -498,17 +499,17 @@ classifyDataReference :: Core.Name -> t0 -> Graph.Graph -> Either Errors.Error JavaEnvironment.JavaSymbolClass classifyDataReference name cx g = - Eithers.bind (Right (Lexical.lookupBinding g name)) (\mel -> Optionals.cases mel (Right JavaEnvironment.JavaSymbolClassLocalVariable) (\el -> Optionals.cases (Core.bindingTypeScheme el) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "no type scheme for element " (Core.unName (Core.bindingName el)))))) (\ts -> Right (classifyDataTerm ts (Core.bindingTerm el))))) + Eithers.bind (Right (Lexical.lookupBinding g name)) (\mel -> Optionals.cases mel (Right JavaEnvironment.JavaSymbolClassLocalVariable) (\el -> Optionals.cases (Core.bindingTypeScheme el) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "no type scheme for element " (Core.unName (Core.bindingName el)))))) (\ts -> Right (classifyDataTerm ts (Core.bindingTerm el))))) classifyDataTerm :: Core.TypeScheme -> Core.Term -> JavaEnvironment.JavaSymbolClass classifyDataTerm ts term = Logic.ifElse (Dependencies.isLambda term) ( let n = classifyDataTerm_countLambdaParams term - in (Logic.ifElse (Equality.gt n 1) (JavaEnvironment.JavaSymbolClassHoistedLambda n) JavaEnvironment.JavaSymbolClassUnaryFunction)) ( + in (Logic.ifElse (Ordering.gt n 1) (JavaEnvironment.JavaSymbolClassHoistedLambda n) JavaEnvironment.JavaSymbolClassUnaryFunction)) ( let hasTypeParams = Logic.not (Lists.null (Core.typeSchemeVariables ts)) in (Logic.ifElse hasTypeParams ( let n2 = classifyDataTerm_countLambdaParams (classifyDataTerm_stripTypeLambdas term) - in (Logic.ifElse (Equality.gt n2 0) (JavaEnvironment.JavaSymbolClassHoistedLambda n2) JavaEnvironment.JavaSymbolClassNullaryFunction)) JavaEnvironment.JavaSymbolClassNullaryFunction)) + in (Logic.ifElse (Ordering.gt n2 0) (JavaEnvironment.JavaSymbolClassHoistedLambda n2) JavaEnvironment.JavaSymbolClassNullaryFunction)) JavaEnvironment.JavaSymbolClassNullaryFunction)) classifyDataTerm_countLambdaParams :: Core.Term -> Int classifyDataTerm_countLambdaParams t = @@ -635,13 +636,13 @@ let zeroStmts = [ Syntax.BlockStatementStatement (Utils.javaReturnStatement (Just (Utils.javaIntExpression 0)))] - in (Optionals.fromOptional zeroStmts (Optionals.map (\p -> + in (Optionals.withDefault zeroStmts (Optionals.map (\p -> let firstField = Pairs.first p restFields = Pairs.second p in (Logic.ifElse (Lists.null restFields) [ Syntax.BlockStatementStatement (Utils.javaReturnStatement (Just (compareFieldExpr otherVar firstField)))] (Lists.concat2 [ - cmpDeclStatement aliases] (Lists.concat2 (Lists.concat (Lists.map (\f -> compareAndReturnStmts otherVar f) (Lists.cons firstField (Optionals.fromOptional [] (Lists.maybeInit restFields))))) [ - Syntax.BlockStatementStatement (Utils.javaReturnStatement (Just (compareFieldExpr otherVar (Optionals.fromOptional firstField (Lists.maybeLast restFields)))))])))) (Lists.uncons fields))) + cmpDeclStatement aliases] (Lists.concat2 (Lists.concat (Lists.map (\f -> compareAndReturnStmts otherVar f) (Lists.cons firstField (Optionals.withDefault [] (Lists.init restFields))))) [ + Syntax.BlockStatementStatement (Utils.javaReturnStatement (Just (compareFieldExpr otherVar (Optionals.withDefault firstField (Lists.last restFields)))))])))) (Lists.uncons fields))) compareToZeroClause :: String -> String -> Syntax.InclusiveOrExpression compareToZeroClause tmpName fname = @@ -693,7 +694,7 @@ javaName = Formatting.nonAlnumToUnderscores (Formatting.convertCase Util.CaseConventionCamel Util.CaseConventionUpperSnake (Core.unName name)) comment = - Strings.cat [ + Strings.concat [ "Name of the {@code ", (Core.unName parentName), ".", @@ -705,7 +706,7 @@ constantDeclForTypeName aliases name cx g = let comment = - Strings.cat [ + Strings.concat [ "Name of the {@code ", (Core.unName name), "} type."] @@ -746,8 +747,8 @@ correctCastType innerBody typeArgs fallback cx g = case (Strip.deannotateTerm innerBody) of Core.TermPair _ -> Logic.ifElse (Equality.equal (Lists.length typeArgs) 2) (Right (Core.TypePair (Core.PairType { - Core.pairTypeFirst = (Optionals.fromOptional fallback (Lists.maybeAt 0 typeArgs)), - Core.pairTypeSecond = (Optionals.fromOptional fallback (Lists.maybeAt 1 typeArgs))}))) (Right fallback) + Core.pairTypeFirst = (Optionals.withDefault fallback (Lists.at 0 typeArgs)), + Core.pairTypeSecond = (Optionals.withDefault fallback (Lists.at 1 typeArgs))}))) (Right fallback) _ -> Right fallback correctTypeApps :: t0 -> Core.Name -> [Core.Term] -> [Core.Type] -> t1 -> Graph.Graph -> Either Errors.Error [Core.Type] @@ -794,18 +795,18 @@ declarationForRecordType :: Bool -> Bool -> JavaEnvironment.Aliases -> [Syntax.TypeParameter] -> Core.Name -> [Core.FieldType] -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error Syntax.ClassDeclaration declarationForRecordType isInner isSer aliases tparams elName fields cx g = - declarationForRecordType_ isInner isSer aliases tparams elName Nothing fields cx g + declarationForRecordType_ isInner isSer aliases tparams elName Nothing Nothing fields cx g -declarationForRecordType_ :: Bool -> Bool -> JavaEnvironment.Aliases -> [Syntax.TypeParameter] -> Core.Name -> Maybe Core.Name -> [Core.FieldType] -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error Syntax.ClassDeclaration -declarationForRecordType_ isInner isSer aliases tparams elName parentName fields cx g = +declarationForRecordType_ :: Bool -> Bool -> JavaEnvironment.Aliases -> [Syntax.TypeParameter] -> Core.Name -> Maybe Core.Name -> Maybe Int -> [Core.FieldType] -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error Syntax.ClassDeclaration +declarationForRecordType_ isInner isSer aliases tparams elName parentName ordinal fields cx g = Eithers.bind (Eithers.mapList (\f -> recordMemberVar aliases f cx g) fields) (\memberVars -> Eithers.bind (Eithers.mapList (\p -> addComment (Pairs.first p) (Pairs.second p) cx g) (Lists.zip memberVars fields)) (\memberVars_ -> let elNameStr = Syntax.unIdentifier (Utils.nameToJavaName aliases elName) linkTargetStr = - Optionals.cases parentName elNameStr (\pn -> Strings.cat2 (Strings.cat2 (Syntax.unIdentifier (Utils.nameToJavaName aliases pn)) ".") (Utils.sanitizeJavaName (Util.qualifiedNameLocal (Names.qualifyName elName)))) - in (Eithers.bind (Logic.ifElse (Equality.gt (Lists.length fields) 1) (Eithers.mapList (\f -> Eithers.bind (recordWithMethod aliases elName fields f cx g) (\decl -> + Optionals.cases parentName elNameStr (\pn -> Strings.concat2 (Strings.concat2 (Syntax.unIdentifier (Utils.nameToJavaName aliases pn)) ".") (Utils.sanitizeJavaName (Util.qualifiedNameLocal (Names.qualifyName elName)))) + in (Eithers.bind (Logic.ifElse (Ordering.gt (Lists.length fields) 1) (Eithers.mapList (\f -> Eithers.bind (recordWithMethod aliases elName fields f cx g) (\decl -> let fname = Core.unName (Core.fieldTypeName f) comment = - Strings.cat [ + Strings.concat [ "Returns a copy of this {@link ", linkTargetStr, "} with {@code ", @@ -813,28 +814,27 @@ "} replaced."] in (Right (withCommentString comment decl)))) fields) (Right [])) (\withMethods -> Eithers.bind (recordConstructor aliases elName fields cx g) (\cons -> Eithers.bind (Eithers.mapList (\f -> let fname = Utils.sanitizeJavaName (Core.unName (Core.fieldTypeName f)) - in (Eithers.bind (Annotations.commentsFromFieldType cx g f) (\mDoc -> Right (Optionals.cases mDoc "" (\d -> Strings.cat [ + in (Eithers.bind (Annotations.commentsFromFieldType cx g f) (\mDoc -> Right (Optionals.cases mDoc "" (\d -> Strings.concat [ "@param ", fname, " ", d]))))) fields) (\paramLines -> let nonEmptyParamLines = Lists.filter (\l -> Logic.not (Equality.equal l "")) paramLines consBaseComment = - Strings.cat [ + Strings.concat [ "Constructs an immutable {@link ", linkTargetStr, "}."] consComment = - Logic.ifElse (Lists.null nonEmptyParamLines) consBaseComment (Strings.cat [ + Logic.ifElse (Lists.null nonEmptyParamLines) consBaseComment (Strings.concat [ consBaseComment, "\n\n", - (Strings.intercalate "\n" nonEmptyParamLines)]) + (Strings.join "\n" nonEmptyParamLines)]) consWithComment = withCommentString consComment cons in (Eithers.bind (Logic.ifElse isInner (Right []) (Eithers.bind (constantDeclForTypeName aliases elName cx g) (\d -> Eithers.bind (Eithers.mapList (\f -> constantDeclForFieldType elName aliases f cx g) fields) (\dfields -> Right (Lists.cons d dfields))))) (\tn -> Eithers.bind (Logic.ifElse isInner (Right []) (recordBuilderClass aliases tparams elName fields cx g)) (\builderDecls -> let comparableMethods = Optionals.cases parentName (Logic.ifElse (Logic.and (Logic.not isInner) isSer) [ - recordCompareToMethod aliases tparams elName fields] []) (\pn -> Logic.ifElse isSer [ - variantCompareToMethod aliases tparams pn elName fields] []) + recordCompareToMethod aliases tparams elName fields] []) (\pn -> Logic.ifElse isSer (variantCompareToMethod aliases tparams pn elName (Optionals.withDefault 0 ordinal) fields) []) noCommentMethods = Lists.map (\x -> noComment x) (Lists.concat2 [ recordEqualsMethod aliases elName fields, @@ -853,8 +853,10 @@ declarationForUnionType :: Bool -> JavaEnvironment.Aliases -> [Syntax.TypeParameter] -> Core.Name -> [Core.FieldType] -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error Syntax.ClassDeclaration declarationForUnionType isSer aliases tparams elName fields cx g = - Eithers.bind (Eithers.mapList (\ft -> - let fname = Core.fieldTypeName ft + Eithers.bind (Eithers.mapList (\ftord -> + let ft = Pairs.first ftord + ordinal = Pairs.second ftord + fname = Core.fieldTypeName ft ftype = Core.fieldTypeType ft rfields = Logic.ifElse (Predicates.isUnitType (Strip.deannotateType ftype)) [] [ @@ -862,7 +864,7 @@ Core.fieldTypeName = (Core.Name "value"), Core.fieldTypeType = (Strip.deannotateType ftype)}] varName = Utils.variantClassName False elName fname - in (Eithers.bind (declarationForRecordType_ True isSer aliases [] varName (Logic.ifElse isSer (Just elName) Nothing) rfields cx g) (\innerDecl -> Right (augmentVariantClass aliases tparams elName innerDecl)))) fields) (\variantClasses -> + in (Eithers.bind (declarationForRecordType_ True isSer aliases [] varName (Logic.ifElse isSer (Just elName) Nothing) (Logic.ifElse isSer (Just ordinal) Nothing) rfields cx g) (\innerDecl -> Right (augmentVariantClass aliases tparams elName innerDecl)))) (Lists.zip fields (Math.range 0 (Math.sub (Lists.length fields) 1)))) (\variantClasses -> let variantDecls = Lists.map (\vc -> Syntax.ClassBodyDeclarationClassMember (Syntax.ClassMemberDeclarationClass vc)) variantClasses in (Eithers.bind (Eithers.mapList (\pair -> addComment (Pairs.first pair) (Pairs.second pair) cx g) (Lists.zip variantDecls fields)) (\variantDecls_ -> @@ -879,12 +881,12 @@ varName = Utils.variantClassName False elName fname varNameStr = Syntax.unIdentifier (Utils.nameToJavaName aliases varName) varLocalStr = Utils.sanitizeJavaName (Util.qualifiedNameLocal (Names.qualifyName varName)) - linkVarNameStr = Strings.cat2 (Strings.cat2 elNameStr ".") varLocalStr + linkVarNameStr = Strings.concat2 (Strings.concat2 elNameStr ".") varLocalStr varRef = Utils.javaClassTypeToJavaType (Utils.nameToJavaClassType aliases False typeArgs varName Nothing) param = Utils.javaTypeToJavaFormalParameter varRef (Core.Name "instance") resultR = Utils.javaTypeToJavaResult (Syntax.TypeReference Utils.visitorTypeVariable) comment = - Strings.cat [ + Strings.concat [ "Visit the {@link ", linkVarNameStr, "} case."] @@ -926,7 +928,7 @@ varName = Utils.variantClassName False elName fname varNameStr = Syntax.unIdentifier (Utils.nameToJavaName aliases varName) varLocalStr = Utils.sanitizeJavaName (Util.qualifiedNameLocal (Names.qualifyName varName)) - linkVarNameStr = Strings.cat2 (Strings.cat2 elNameStr ".") varLocalStr + linkVarNameStr = Strings.concat2 (Strings.concat2 elNameStr ".") varLocalStr varRef = Utils.javaClassTypeToJavaType (Utils.nameToJavaClassType aliases False typeArgs varName Nothing) param = Utils.javaTypeToJavaFormalParameter varRef (Core.Name "instance") mi = @@ -935,7 +937,7 @@ returnOtherwise = Syntax.BlockStatementStatement (Utils.javaReturnStatement (Just (Utils.javaPrimaryToJavaExpression (Utils.javaMethodInvocationToJavaPrimary mi)))) comment = - Strings.cat [ + Strings.concat [ "Visit the {@link ", linkVarNameStr, "} case."] @@ -960,27 +962,29 @@ let tn = Lists.concat2 [ tn0] tn1 privateConstComment = - Strings.cat [ + Strings.concat [ "Constructs an immutable {@link ", elNameStr, "}."] acceptComment = "Dispatch to {@code visitor}." visitorIfaceComment = - Strings.cat [ + Strings.concat [ "Visitor over {@link ", elNameStr, "}."] partialVisitorIfaceComment = - Strings.cat [ + Strings.concat [ "Partial visitor over {@link ", elNameStr, "} with a default {@link #otherwise} branch."] + hydraOrdinalAbstractDecls = Logic.ifElse isSer [ + noComment (hydraOrdinalMethod Nothing)] [] otherDecls = - [ + Lists.concat2 [ withCommentString privateConstComment privateConst, (withCommentString acceptComment acceptDecl), (withCommentString visitorIfaceComment visitor), - (withCommentString partialVisitorIfaceComment partialVisitor)] + (withCommentString partialVisitorIfaceComment partialVisitor)] hydraOrdinalAbstractDecls bodyDecls = Lists.concat [ tn, @@ -1003,13 +1007,13 @@ _ -> Nothing _ -> Nothing _ -> Nothing) (Logic.ifElse (Equality.equal fname "annotated") (case fterm of - Core.TermRecord v1 -> Optionals.bind (Lists.maybeHead (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.Name "body")) (Core.recordFields v1))) (\bodyField -> decodeTypeFromTerm (Core.fieldTerm bodyField)) + Core.TermRecord v1 -> Optionals.bind (Lists.head (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.Name "body")) (Core.recordFields v1))) (\bodyField -> decodeTypeFromTerm (Core.fieldTerm bodyField)) _ -> Nothing) (Logic.ifElse (Equality.equal fname "application") (case fterm of - Core.TermRecord v1 -> Optionals.bind (Lists.maybeHead (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.Name "function")) (Core.recordFields v1))) (\funcField -> Optionals.bind (decodeTypeFromTerm (Core.fieldTerm funcField)) (\func -> Optionals.bind (Lists.maybeHead (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.Name "argument")) (Core.recordFields v1))) (\argField -> Optionals.map (\arg -> Core.TypeApplication (Core.ApplicationType { + Core.TermRecord v1 -> Optionals.bind (Lists.head (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.Name "function")) (Core.recordFields v1))) (\funcField -> Optionals.bind (decodeTypeFromTerm (Core.fieldTerm funcField)) (\func -> Optionals.bind (Lists.head (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.Name "argument")) (Core.recordFields v1))) (\argField -> Optionals.map (\arg -> Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = func, Core.applicationTypeArgument = arg})) (decodeTypeFromTerm (Core.fieldTerm argField))))) _ -> Nothing) (Logic.ifElse (Equality.equal fname "function") (case fterm of - Core.TermRecord v1 -> Optionals.bind (Lists.maybeHead (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.Name "domain")) (Core.recordFields v1))) (\domField -> Optionals.bind (decodeTypeFromTerm (Core.fieldTerm domField)) (\dom -> Optionals.bind (Lists.maybeHead (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.Name "codomain")) (Core.recordFields v1))) (\codField -> Optionals.map (\cod -> Core.TypeFunction (Core.FunctionType { + Core.TermRecord v1 -> Optionals.bind (Lists.head (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.Name "domain")) (Core.recordFields v1))) (\domField -> Optionals.bind (decodeTypeFromTerm (Core.fieldTerm domField)) (\dom -> Optionals.bind (Lists.head (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.Name "codomain")) (Core.recordFields v1))) (\codField -> Optionals.map (\cod -> Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = dom, Core.functionTypeCodomain = cod})) (decodeTypeFromTerm (Core.fieldTerm codField))))) _ -> Nothing) (Logic.ifElse (Equality.equal fname "literal") (case fterm of @@ -1019,7 +1023,7 @@ dedupBindings :: S.Set Core.Name -> [Core.Binding] -> [Core.Binding] dedupBindings inScope bs = - Optionals.fromOptional [] (Optionals.map (\p -> + Optionals.withDefault [] (Optionals.map (\p -> let b = Pairs.first p rest = Pairs.second p name = Core.bindingName b @@ -1069,7 +1073,7 @@ nonSelfVars = Lists.filter (\v -> Logic.not (Equality.equal v inVar)) outVars safeNonSelfVars = Lists.filter (\v -> Logic.and (Logic.not (Sets.member v directInputVars)) (Logic.not (Equality.equal (Just v) codVar))) nonSelfVars - in (Logic.ifElse (Logic.and (Equality.gte selfRefCount 2) (Logic.not (Lists.null safeNonSelfVars))) (Lists.foldl (\s -> \v -> Maps.insert v inVar s) subst safeNonSelfVars) subst) + in (Logic.ifElse (Logic.and (Ordering.gte selfRefCount 2) (Logic.not (Lists.null safeNonSelfVars))) (Lists.foldl (\s -> \v -> Maps.insert v inVar s) subst safeNonSelfVars) subst) domTypeArgs :: JavaEnvironment.Aliases -> Core.Type -> t0 -> Graph.Graph -> Either Errors.Error [Syntax.TypeArgument] domTypeArgs aliases d cx g = @@ -1084,7 +1088,7 @@ ns_ = Util.qualifiedNameModuleName qn local = Util.qualifiedNameLocal qn sep = Logic.ifElse isMethod "::" "." - in (Logic.ifElse isPrim (Syntax.Identifier (Strings.cat2 (Strings.cat2 (elementJavaIdentifier_qualify aliases ns_ (Formatting.capitalize local)) ".") JavaNames.applyMethodName)) (Optionals.cases ns_ (Syntax.Identifier (Utils.sanitizeJavaName local)) (\n -> Syntax.Identifier (Strings.cat2 (Strings.cat2 (elementJavaIdentifier_qualify aliases (namespaceParent n) (elementsClassName n)) sep) (Utils.sanitizeJavaName local))))) + in (Logic.ifElse isPrim (Syntax.Identifier (Strings.concat2 (Strings.concat2 (elementJavaIdentifier_qualify aliases ns_ (Formatting.capitalize local)) ".") JavaNames.applyMethodName)) (Optionals.cases ns_ (Syntax.Identifier (Utils.sanitizeJavaName local)) (\n -> Syntax.Identifier (Strings.concat2 (Strings.concat2 (elementJavaIdentifier_qualify aliases (namespaceParent n) (elementsClassName n)) sep) (Utils.sanitizeJavaName local))))) elementJavaIdentifier_qualify :: JavaEnvironment.Aliases -> Maybe Packaging.ModuleName -> String -> String elementJavaIdentifier_qualify aliases mns s = @@ -1097,7 +1101,7 @@ let nsStr = Packaging.unModuleName ns parts = Strings.splitOn "." nsStr - in (Formatting.sanitizeWithUnderscores Language.reservedWords (Formatting.capitalize (Optionals.fromOptional nsStr (Lists.maybeLast parts)))) + in (Formatting.sanitizeWithUnderscores Language.reservedWords (Formatting.capitalize (Optionals.withDefault nsStr (Lists.last parts)))) elementsQualifiedName :: Packaging.ModuleName -> Core.Name elementsQualifiedName ns = @@ -1125,7 +1129,7 @@ Core.TermVariable v0 -> Logic.ifElse (Optionals.isGiven (Maps.lookup v0 (Graph.graphPrimitives g))) ( let hargs = Lists.take arity annotatedArgs rargs = Lists.drop arity annotatedArgs - in (Eithers.bind (functionCall env True v0 hargs [] cx g) (\initialCall -> Eithers.foldl (\acc -> \h -> Eithers.bind (encodeTerm env h cx g) (\jarg -> Right (applyJavaArg acc jarg))) initialCall rargs))) (Logic.ifElse (Logic.and (isRecursiveVariable aliases v0) (Logic.not (isLambdaBoundIn v0 (JavaEnvironment.aliasesLambdaVars aliases)))) (encodeApplication_fallback env aliases g typeApps (Core.applicationFunction app) (Core.applicationArgument app) cx g) (Eithers.bind (classifyDataReference v0 cx g) (\symClass -> + in (Eithers.bind (functionCall env True v0 hargs [] cx g) (\initialCall -> Eithers.foldList (\acc -> \h -> Eithers.bind (encodeTerm env h cx g) (\jarg -> Right (applyJavaArg acc jarg))) initialCall rargs))) (Logic.ifElse (Logic.and (isRecursiveVariable aliases v0) (Logic.not (isLambdaBoundIn v0 (JavaEnvironment.aliasesLambdaVars aliases)))) (encodeApplication_fallback env aliases g typeApps (Core.applicationFunction app) (Core.applicationArgument app) cx g) (Eithers.bind (classifyDataReference v0 cx g) (\symClass -> let methodArity = case symClass of JavaEnvironment.JavaSymbolClassHoistedLambda v1 -> v1 @@ -1138,7 +1142,7 @@ Logic.ifElse (Logic.or (Sets.null trusted) (Sets.null inScope)) [] ( let allVars = Sets.unions (Lists.map (\t -> collectTypeVars t) typeApps) in (Logic.ifElse (Logic.not (Sets.null (Sets.difference allVars inScope))) [] (Logic.ifElse (Sets.null (Sets.difference allVars trusted)) typeApps []))) - in (Eithers.bind (Logic.ifElse (Lists.null filteredTypeApps) (Right []) (correctTypeApps g v0 hargs filteredTypeApps cx g)) (\safeTypeApps -> Eithers.bind (filterPhantomTypeArgs v0 safeTypeApps cx g) (\finalTypeApps -> Eithers.bind (functionCall env False v0 hargs finalTypeApps cx g) (\initialCall -> Eithers.foldl (\acc -> \h -> Eithers.bind (encodeTerm env h cx g) (\jarg -> Right (applyJavaArg acc jarg))) initialCall rargs))))))) + in (Eithers.bind (Logic.ifElse (Lists.null filteredTypeApps) (Right []) (correctTypeApps g v0 hargs filteredTypeApps cx g)) (\safeTypeApps -> Eithers.bind (filterPhantomTypeArgs v0 safeTypeApps cx g) (\finalTypeApps -> Eithers.bind (functionCall env False v0 hargs finalTypeApps cx g) (\initialCall -> Eithers.foldList (\acc -> \h -> Eithers.bind (encodeTerm env h cx g) (\jarg -> Right (applyJavaArg acc jarg))) initialCall rargs))))))) _ -> encodeApplication_fallback env aliases g typeApps (Core.applicationFunction app) (Core.applicationArgument app) cx g))))) encodeApplication_fallback :: JavaEnvironment.JavaEnvironment -> JavaEnvironment.Aliases -> Graph.Graph -> [Core.Type] -> Core.Term -> Core.Term -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error Syntax.Expression @@ -1238,7 +1242,7 @@ let wVar = Core.Name "wrapped" wArg = Utils.javaIdentifierToJavaExpression (Utils.variableToJavaIdentifier wVar) in (Utils.javaLambda wVar (withArg wArg))) (\jarg -> withArg jarg))) - _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "unexpected " (Strings.cat2 "elimination case" (Strings.cat2 " in " "encodeElimination"))))) + _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "unexpected " (Strings.concat2 "elimination case" (Strings.concat2 " in " "encodeElimination"))))) encodeFunction :: JavaEnvironment.JavaEnvironment -> Core.Type -> Core.Type -> Core.Term -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error Syntax.Expression encodeFunction env dom cod funTerm cx g = @@ -1281,9 +1285,9 @@ in (applyCastIfSafe aliases (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = dom, Core.functionTypeCodomain = cod})) lam1 cx g))) - _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "expected function type for lambda body, but got: " (PrintCore.type_ cod)))) + _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "expected function type for lambda body, but got: " (PrintCore.type_ cod)))) _ -> encodeLambdaFallback env2 v0) - _ -> Right (encodeLiteral (Core.LiteralString (Strings.cat2 "Unimplemented function variant: " (PrintCore.term funTerm)))) + _ -> Right (encodeLiteral (Core.LiteralString (Strings.concat2 "Unimplemented function variant: " (PrintCore.term funTerm)))) encodeFunctionFormTerm :: JavaEnvironment.JavaEnvironment -> [M.Map Core.Name Core.Term] -> Core.Term -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error Syntax.Expression encodeFunctionFormTerm env anns term cx g = @@ -1298,18 +1302,18 @@ let aliases = JavaEnvironment.javaEnvironmentAliases env classWithApply = Syntax.unIdentifier (elementJavaIdentifier True False aliases name) - suffix = Strings.cat2 "." JavaNames.applyMethodName + suffix = Strings.concat2 "." JavaNames.applyMethodName className = Strings.fromList (Lists.take (Math.sub (Strings.length classWithApply) (Strings.length suffix)) (Strings.toList classWithApply)) arity = Arity.typeArity (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = dom, Core.functionTypeCodomain = cod})) - in (Logic.ifElse (Equality.lte arity 1) (Right (Utils.javaIdentifierToJavaExpression (Syntax.Identifier (Strings.cat [ + in (Logic.ifElse (Ordering.lte arity 1) (Right (Utils.javaIdentifierToJavaExpression (Syntax.Identifier (Strings.concat [ className, "::", JavaNames.applyMethodName])))) ( - let paramNames = Lists.map (\i -> Core.Name (Strings.cat2 "p" (Literals.showInt32 i))) (Math.range 0 (Math.sub arity 1)) + let paramNames = Lists.map (\i -> Core.Name (Strings.concat2 "p" (Literals.showInt32 i))) (Math.range 0 (Math.sub arity 1)) paramExprs = Lists.map (\p -> Utils.javaIdentifierToJavaExpression (Utils.variableToJavaIdentifier p)) paramNames classId = Syntax.Identifier className call = @@ -1324,7 +1328,7 @@ case lit of Core.LiteralBinary v0 -> let byteValues = Literals.binaryToBytes v0 - in (Utils.javaArrayCreation Utils.javaBytePrimitiveType (Just (Utils.javaArrayInitializer (Lists.map (\w -> Utils.javaLiteralToJavaExpression (Syntax.LiteralInteger (Syntax.IntegerLiteral (Literals.int32ToBigint (Logic.ifElse (Equality.gt w 127) (Math.sub w 256) w))))) byteValues)))) + in (Utils.javaArrayCreation Utils.javaBytePrimitiveType (Just (Utils.javaArrayInitializer (Lists.map (\w -> Utils.javaLiteralToJavaExpression (Syntax.LiteralInteger (Syntax.IntegerLiteral (Literals.int32ToBigint (Logic.ifElse (Ordering.gt w 127) (Math.sub w 256) w))))) byteValues)))) Core.LiteralBoolean v0 -> encodeLiteral_litExp (Utils.javaBoolean v0) Core.LiteralDecimal v0 -> Utils.javaConstructorCall (Utils.javaConstructorName (Syntax.Identifier "java.math.BigDecimal") Nothing) [ encodeLiteral (Core.LiteralString (Literals.showDecimal v0))] Nothing @@ -1421,7 +1425,7 @@ encodeNullaryConstant :: t0 -> t1 -> Core.Term -> t2 -> t3 -> Either Errors.Error t4 encodeNullaryConstant env typ funTerm cx g = - Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "unexpected " (Strings.cat2 "nullary function" (Strings.cat2 " in " (PrintCore.term funTerm)))))) + Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "unexpected " (Strings.concat2 "nullary function" (Strings.concat2 " in " (PrintCore.term funTerm)))))) encodeNullaryConstant_typeArgsFromReturnType :: JavaEnvironment.Aliases -> Core.Type -> t0 -> Graph.Graph -> Either Errors.Error [Syntax.TypeArgument] encodeNullaryConstant_typeArgsFromReturnType aliases t cx g = @@ -1448,8 +1452,8 @@ Syntax.methodInvocationArguments = []})))) ( let fullName = Syntax.unIdentifier (elementJavaIdentifier True False aliases name) parts = Strings.splitOn "." fullName - className = Syntax.Identifier (Strings.intercalate "." (Optionals.fromOptional [] (Lists.maybeInit parts))) - methodName = Syntax.Identifier (Optionals.fromOptional fullName (Lists.maybeLast parts)) + className = Syntax.Identifier (Strings.join "." (Optionals.withDefault [] (Lists.init parts))) + methodName = Syntax.Identifier (Optionals.withDefault fullName (Lists.last parts)) in (Right (Utils.javaMethodInvocationToJavaExpression (Utils.methodInvocationStaticWithTypeArgs className methodName targs [])))))) encodeTerm :: JavaEnvironment.JavaEnvironment -> Core.Term -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error Syntax.Expression @@ -1487,7 +1491,7 @@ in (Eithers.bind (Logic.ifElse (Lists.null tparams) (Right Maps.empty) (buildSubstFromAnnotations schemeVarSet term cx g)) (\typeVarSubst -> let overgenSubst = detectAccumulatorUnification schemeDoms cod tparams overgenVarSubst = - Maps.fromList (Optionals.cat (Lists.map (\entry -> + Maps.fromList (Optionals.givens (Lists.map (\entry -> let k = Pairs.first entry v = Pairs.second entry in case v of @@ -1498,7 +1502,7 @@ Logic.ifElse (Maps.null overgenSubst) schemeDoms (Lists.map (\d -> substituteTypeVarsWithTypes overgenSubst d) schemeDoms) fixedTparams = Logic.ifElse (Maps.null overgenSubst) tparams (Lists.filter (\v -> Logic.not (Maps.member v overgenSubst)) tparams) - constraints = Optionals.fromOptional Maps.empty (Core.typeSchemeConstraints ts) + constraints = Optionals.withDefault Maps.empty (Core.typeSchemeConstraints ts) jparams = Lists.map (\v -> Utils.javaTypeParameter (Formatting.capitalize (Core.unName v))) fixedTparams aliases2base = JavaEnvironment.javaEnvironmentAliases env2 trustedVars = Sets.unions (Lists.map (\d -> collectTypeVars d) (Lists.concat2 fixedDoms [ @@ -1536,7 +1540,7 @@ isTCO = False in (Eithers.bind (Logic.ifElse isTCO ( let tcoSuffix = "_tco" - snapshotNames = Lists.map (\p -> Core.Name (Strings.cat2 (Core.unName p) tcoSuffix)) params + snapshotNames = Lists.map (\p -> Core.Name (Strings.concat2 (Core.unName p) tcoSuffix)) params tcoVarRenames = Maps.fromList (Lists.zip params snapshotNames) snapshotDecls = Lists.map (\pair -> Utils.finalVarDeclarationStatement (Utils.variableToJavaIdentifier (Pairs.second pair)) (Utils.javaIdentifierToJavaExpression (Utils.variableToJavaIdentifier (Pairs.first pair)))) (Lists.zip params snapshotNames) @@ -1675,7 +1679,7 @@ injFieldTerm = Core.fieldTerm injField typeId = Syntax.unIdentifier (Utils.nameToJavaName aliases injTypeName) consId = - Syntax.Identifier (Strings.cat [ + Syntax.Identifier (Strings.concat [ typeId, ".", (Utils.sanitizeJavaName (Formatting.capitalize (Core.unName injFieldName)))]) @@ -1708,9 +1712,7 @@ Core.TermVariable v1 -> Eithers.bind (classifyDataReference v1 cx g) (\cls -> typeAppNullaryOrHoisted env aliases anns tyapps jatyp body correctedTyp v1 cls allTypeArgs cx g) Core.TermEither v1 -> Logic.ifElse (Equality.equal (Lists.length allTypeArgs) 2) ( let eitherBranchTypes = - ( - Optionals.fromOptional correctedTyp (Lists.maybeAt 0 allTypeArgs), - (Optionals.fromOptional correctedTyp (Lists.maybeAt 1 allTypeArgs))) + (Optionals.withDefault correctedTyp (Lists.at 0 allTypeArgs), (Optionals.withDefault correctedTyp (Lists.at 1 allTypeArgs))) in (Eithers.bind (Eithers.mapList (\t -> Eithers.bind (encodeType aliases Sets.empty t cx g) (\jt -> Utils.javaTypeToJavaReferenceType jt cx)) allTypeArgs) (\jTypeArgs -> let eitherTargs = Lists.map (\rt -> Syntax.TypeArgumentReference rt) jTypeArgs encodeEitherBranch = @@ -1781,7 +1783,7 @@ args2 = Pairs.first gathered2 body2 = Pairs.second gathered2 in (Logic.ifElse (Equality.equal (Lists.length args2) 1) ( - let arg = Optionals.fromOptional Core.TermUnit (Lists.maybeHead args2) + let arg = Optionals.withDefault Core.TermUnit (Lists.head args2) in case (Strip.deannotateAndDetypeTerm body2) of Core.TermCases v0 -> let aliases = JavaEnvironment.javaEnvironmentAliases env @@ -1791,7 +1793,7 @@ in (Eithers.bind (domTypeArgs aliases (Resolution.nominalApplication tname []) cx g) (\domArgs -> Eithers.bind (encodeTerm env arg cx g) (\jArgRaw -> let depthSuffix = Logic.ifElse (Equality.equal tcoDepth 0) "" (Literals.showInt32 tcoDepth) matchVarId = - Utils.javaIdentifier (Strings.cat [ + Utils.javaIdentifier (Strings.concat [ "_tco_match_", (Formatting.decapitalize (Names.localNameOf tname)), depthSuffix]) @@ -1873,10 +1875,10 @@ jst] JavaNames.javaUtilPackageName "Set")) Core.TypeUnion _ -> Left (Errors.ErrorOther (Errors.OtherError "unexpected anonymous union type")) Core.TypeVariable v0 -> - let name = Optionals.fromOptional v0 (Maps.lookup v0 typeVarSubst) + let name = Optionals.withDefault v0 (Maps.lookup v0 typeVarSubst) in (Eithers.bind (encodeType_resolveIfTypedef aliases boundVars inScopeTypeParams name cx g) (\resolved -> Optionals.cases resolved (Right (Logic.ifElse (Logic.or (Sets.member name boundVars) (Sets.member name inScopeTypeParams)) (Syntax.TypeReference (Utils.javaTypeVariable (Core.unName name))) (Logic.ifElse (isLambdaBoundVariable name) (Syntax.TypeReference (Utils.javaTypeVariable (Core.unName name))) (Logic.ifElse (isUnresolvedInferenceVar name) (Syntax.TypeReference (Syntax.ReferenceTypeClassOrInterface (Syntax.ClassOrInterfaceTypeClass (Utils.javaClassType [] JavaNames.javaLangPackageName "Object")))) (Syntax.TypeReference (Utils.nameToJavaReferenceType aliases True [] name Nothing)))))) (\resolvedType -> encodeType aliases boundVars resolvedType cx g))) Core.TypeWrap _ -> Left (Errors.ErrorOther (Errors.OtherError "unexpected anonymous wrap type")) - _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "can't encode unsupported type in Java: " (PrintCore.type_ t)))) + _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "can't encode unsupported type in Java: " (PrintCore.type_ t)))) encodeTypeDefinition :: Syntax.PackageDeclaration -> JavaEnvironment.Aliases -> Packaging.TypeDefinition -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error (Core.Name, Syntax.CompilationUnit) encodeTypeDefinition pkg aliases tdef cx g = @@ -1918,7 +1920,7 @@ jid = Utils.javaIdentifier (Core.unName resolvedName) in (Logic.ifElse (Sets.member name (JavaEnvironment.aliasesBranchVars aliases)) (Right (Utils.javaFieldAccessToJavaExpression (Syntax.FieldAccess { Syntax.fieldAccessQualifier = (Syntax.FieldAccess_QualifierPrimary (Utils.javaExpressionToJavaPrimary (Utils.javaIdentifierToJavaExpression jid))), - Syntax.fieldAccessIdentifier = (Utils.javaIdentifier JavaNames.valueFieldName)}))) (Logic.ifElse (Logic.and (Equality.equal name (Core.Name (Strings.cat [ + Syntax.fieldAccessIdentifier = (Utils.javaIdentifier JavaNames.valueFieldName)}))) (Logic.ifElse (Logic.and (Equality.equal name (Core.Name (Strings.concat [ JavaNames.instanceName, "_", JavaNames.valueFieldName]))) (isRecursiveVariable aliases name)) ( @@ -1941,12 +1943,12 @@ encodeVariable_buildCurried :: [Core.Name] -> Syntax.Expression -> Syntax.Expression encodeVariable_buildCurried params inner = - Optionals.fromOptional inner (Optionals.map (\p -> Utils.javaLambda (Pairs.first p) (encodeVariable_buildCurried (Pairs.second p) inner)) (Lists.uncons params)) + Optionals.withDefault inner (Optionals.map (\p -> Utils.javaLambda (Pairs.first p) (encodeVariable_buildCurried (Pairs.second p) inner)) (Lists.uncons params)) encodeVariable_hoistedLambdaCase :: JavaEnvironment.Aliases -> Core.Name -> Int -> t0 -> Graph.Graph -> Either Errors.Error Syntax.Expression encodeVariable_hoistedLambdaCase aliases name arity cx g = - let paramNames = Lists.map (\i -> Core.Name (Strings.cat2 "p" (Literals.showInt32 i))) (Math.range 0 (Math.sub arity 1)) + let paramNames = Lists.map (\i -> Core.Name (Strings.concat2 "p" (Literals.showInt32 i))) (Math.range 0 (Math.sub arity 1)) paramExprs = Lists.map (\pn -> Utils.javaIdentifierToJavaExpression (Utils.variableToJavaIdentifier pn)) paramNames call = Utils.javaMethodInvocationToJavaExpression (Utils.methodInvocation Nothing (elementJavaIdentifier False False aliases name) paramExprs) @@ -2068,7 +2070,7 @@ findMatchingLambdaVar :: Core.Name -> S.Set Core.Name -> Core.Name findMatchingLambdaVar name lambdaVars = - Logic.ifElse (Sets.member name lambdaVars) name (Logic.ifElse (isLambdaBoundIn_isQualified name) (Optionals.fromOptional name (Lists.find (\lv -> Logic.and (isLambdaBoundIn_isQualified lv) (Equality.equal (Names.localNameOf lv) (Names.localNameOf name))) (Sets.toList lambdaVars))) (Logic.ifElse (Sets.member (Core.Name (Names.localNameOf name)) lambdaVars) (Core.Name (Names.localNameOf name)) name)) + Logic.ifElse (Sets.member name lambdaVars) name (Logic.ifElse (isLambdaBoundIn_isQualified name) (Optionals.withDefault name (Lists.find (\lv -> Logic.and (isLambdaBoundIn_isQualified lv) (Equality.equal (Names.localNameOf lv) (Names.localNameOf name))) (Sets.toList lambdaVars))) (Logic.ifElse (Sets.member (Core.Name (Names.localNameOf name)) lambdaVars) (Core.Name (Names.localNameOf name)) name)) findPairFirst :: Core.Type -> Maybe Core.Name findPairFirst t = @@ -2081,8 +2083,8 @@ findSelfRefVar :: (Eq t0, Ord t0) => (M.Map t0 [t0] -> Maybe t0) findSelfRefVar grouped = - let selfRefs = Lists.filter (\entry -> Lists.elem (Pairs.first entry) (Pairs.second entry)) (Maps.toList grouped) - in (Optionals.map (\entry -> Pairs.first entry) (Lists.maybeHead selfRefs)) + let selfRefs = Lists.filter (\entry -> Lists.member (Pairs.first entry) (Pairs.second entry)) (Maps.toList grouped) + in (Optionals.map (\entry -> Pairs.first entry) (Lists.head selfRefs)) first20Primes :: [Integer] first20Primes = @@ -2131,7 +2133,7 @@ freshJavaName_go :: Core.Name -> S.Set Core.Name -> Int -> Core.Name freshJavaName_go base avoid i = - let candidate = Core.Name (Strings.cat2 (Core.unName base) (Literals.showInt32 i)) + let candidate = Core.Name (Strings.concat2 (Core.unName base) (Literals.showInt32 i)) in (Logic.ifElse (Sets.member candidate avoid) (freshJavaName_go base avoid (Math.add i 1)) candidate) functionCall :: JavaEnvironment.JavaEnvironment -> Bool -> Core.Name -> [Core.Term] -> [Core.Type] -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error Syntax.Expression @@ -2147,7 +2149,7 @@ let overrideMethodName = \jid -> Optionals.cases mMethodOverride jid (\m -> let s = Syntax.unIdentifier jid - in (Syntax.Identifier (Strings.cat2 (Strings.fromList (Lists.take (Math.sub (Strings.length s) (Strings.length JavaNames.applyMethodName)) (Strings.toList s))) m))) + in (Syntax.Identifier (Strings.concat2 (Strings.fromList (Lists.take (Math.sub (Strings.length s) (Strings.length JavaNames.applyMethodName)) (Strings.toList s))) m))) in (Logic.ifElse (Lists.null typeApps) ( let header = Syntax.MethodInvocation_HeaderSimple (Syntax.MethodName (overrideMethodName (elementJavaIdentifier isPrim False aliases name))) @@ -2165,9 +2167,9 @@ Syntax.methodInvocationArguments = jargs})))) (\ns_ -> let classId = Utils.nameToJavaName aliases (elementsQualifiedName ns_) methodId = - Logic.ifElse isPrim (overrideMethodName (Syntax.Identifier (Strings.cat2 (Syntax.unIdentifier (Utils.nameToJavaName aliases (Names.unqualifyName (Util.QualifiedName { + Logic.ifElse isPrim (overrideMethodName (Syntax.Identifier (Strings.concat2 (Syntax.unIdentifier (Utils.nameToJavaName aliases (Names.unqualifyName (Util.QualifiedName { Util.qualifiedNameModuleName = (Just ns_), - Util.qualifiedNameLocal = (Formatting.capitalize localName)})))) (Strings.cat2 "." JavaNames.applyMethodName)))) (Syntax.Identifier (Utils.sanitizeJavaName localName)) + Util.qualifiedNameLocal = (Formatting.capitalize localName)})))) (Strings.concat2 "." JavaNames.applyMethodName)))) (Syntax.Identifier (Utils.sanitizeJavaName localName)) in (Eithers.bind (Eithers.mapList (\t -> Eithers.bind (encodeType aliases Sets.empty t cx g) (\jt -> Eithers.bind (Utils.javaTypeToJavaReferenceType jt cx) (\rt -> Right (Syntax.TypeArgumentReference rt)))) typeApps) (\jTypeArgs -> Right (Utils.javaMethodInvocationToJavaExpression (Utils.methodInvocationStaticWithTypeArgs classId methodId jTypeArgs jargs)))))))))))) getCodomain :: M.Map Core.Name Core.Term -> t0 -> Graph.Graph -> Either Errors.Error Core.Type @@ -2177,7 +2179,7 @@ getFunctionType ann cx g = Eithers.bind (Eithers.bimap (\_de -> Errors.ErrorOther (Errors.OtherError (Errors.unDecodingError _de))) (\_a -> _a) (Annotations.getType g ann)) (\mt -> Optionals.cases mt (Left (Errors.ErrorOther (Errors.OtherError "type annotation is required for function and elimination terms in Java"))) (\t -> case t of Core.TypeFunction v0 -> Right v0 - _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "expected function type, got: " (PrintCore.type_ t)))))) + _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "expected function type, got: " (PrintCore.type_ t)))))) groupPairsByFirst :: Ord t0 => ([(t0, t1)] -> M.Map t0 [t1]) groupPairsByFirst pairs = @@ -2238,11 +2240,27 @@ Syntax.multiplicativeExpression_BinaryLhs = lhs, Syntax.multiplicativeExpression_BinaryRhs = rhs})) +hydraOrdinalMethod :: Maybe Int -> Syntax.ClassBodyDeclaration +hydraOrdinalMethod ordinal = + + let mods = + Logic.ifElse (Optionals.isNone ordinal) [ + Syntax.MethodModifierPublic, + Syntax.MethodModifierAbstract] [ + Syntax.MethodModifierPublic] + anns = Logic.ifElse (Optionals.isNone ordinal) [] [ + Utils.overrideAnnotation] + result = Utils.javaTypeToJavaResult Utils.javaIntType + body = + Optionals.map (\n -> [ + Syntax.BlockStatementStatement (Utils.javaReturnStatement (Just (Utils.javaIntExpression (Literals.int32ToBigint n))))]) ordinal + in (Utils.methodDeclaration mods [] anns JavaNames.hydraOrdinalMethodName [] result body) + innerClassRef :: JavaEnvironment.Aliases -> Core.Name -> String -> Syntax.Identifier innerClassRef aliases name local = let id = Syntax.unIdentifier (Utils.nameToJavaName aliases name) - in (Syntax.Identifier (Strings.cat2 (Strings.cat2 id ".") local)) + in (Syntax.Identifier (Strings.concat2 (Strings.concat2 id ".") local)) insertBranchVar :: Core.Name -> JavaEnvironment.JavaEnvironment -> JavaEnvironment.JavaEnvironment insertBranchVar name env = @@ -2325,7 +2343,7 @@ isLambdaBoundVariable name = let v = Core.unName name - in (Equality.lte (Strings.length v) 4) + in (Ordering.lte (Strings.length v) 4) isLocalVariable :: Core.Name -> Bool isLocalVariable name = Optionals.isNone (Util.qualifiedNameModuleName (Names.qualifyName name)) @@ -2355,13 +2373,13 @@ isUnresolvedInferenceVar name = let chars = Strings.toList (Core.unName name) - in (Optionals.fromOptional False (Optionals.map (\p -> + in (Optionals.withDefault False (Optionals.map (\p -> let firstCh = Pairs.first p rest = Pairs.second p in (Logic.ifElse (Logic.not (Equality.equal firstCh 116)) False (Logic.and (Logic.not (Lists.null rest)) (Lists.null (Lists.filter (\c -> Logic.not (isUnresolvedInferenceVar_isDigit c)) rest))))) (Lists.uncons chars))) isUnresolvedInferenceVar_isDigit :: Int -> Bool -isUnresolvedInferenceVar_isDigit c = Logic.and (Equality.gte c 48) (Equality.lte c 57) +isUnresolvedInferenceVar_isDigit c = Logic.and (Ordering.gte c 48) (Ordering.lte c 57) java11Features :: JavaEnvironment.JavaFeatures java11Features = JavaEnvironment.JavaFeatures { @@ -2407,7 +2425,7 @@ let toParam = \name -> Utils.javaTypeParameter (Formatting.capitalize (Core.unName name)) boundVars = javaTypeParametersForType_bvars typ freeVars = Lists.filter (\v -> isLambdaBoundVariable v) (Sets.toList (Variables.freeVariablesInType typ)) - vars = Lists.nub (Lists.concat2 boundVars freeVars) + vars = Lists.distinct (Lists.concat2 boundVars freeVars) in (Lists.map toParam vars) javaTypeParametersForType_bvars :: Core.Type -> [Core.Name] @@ -2434,8 +2452,8 @@ namespaceParent ns = let parts = Strings.splitOn "." (Packaging.unModuleName ns) - initParts = Optionals.fromOptional [] (Lists.maybeInit parts) - in (Logic.ifElse (Lists.null initParts) Nothing (Just (Packaging.ModuleName (Strings.intercalate "." initParts)))) + initParts = Optionals.withDefault [] (Lists.init parts) + in (Logic.ifElse (Lists.null initParts) Nothing (Just (Packaging.ModuleName (Strings.join "." initParts)))) noComment :: Syntax.ClassBodyDeclaration -> Syntax.ClassBodyDeclarationWithComments noComment decl = @@ -2476,7 +2494,7 @@ peelDomainTypes :: Int -> Core.Type -> ([Core.Type], Core.Type) peelDomainTypes n t = - Logic.ifElse (Equality.lte n 0) ([], t) (case (Strip.deannotateType t) of + Logic.ifElse (Ordering.lte n 0) ([], t) (case (Strip.deannotateType t) of Core.TypeFunction v0 -> let rest = peelDomainTypes (Math.sub n 1) (Core.functionTypeCodomain v0) in (Lists.cons (Core.functionTypeDomain v0) (Pairs.first rest), (Pairs.second rest)) @@ -2484,7 +2502,7 @@ peelDomainsAndCod :: Int -> Core.Type -> ([Core.Type], Core.Type) peelDomainsAndCod n t = - Logic.ifElse (Equality.lte n 0) ([], t) (case (Strip.deannotateType t) of + Logic.ifElse (Ordering.lte n 0) ([], t) (case (Strip.deannotateType t) of Core.TypeFunction v0 -> let rest = peelDomainsAndCod (Math.sub n 1) (Core.functionTypeCodomain v0) in (Lists.cons (Core.functionTypeDomain v0) (Pairs.first rest), (Pairs.second rest)) @@ -2564,7 +2582,7 @@ lambdaDoms = Pairs.first lambdaDomsResult nArgs = Lists.length args nLambdaDoms = Lists.length lambdaDoms - in (Logic.ifElse (Logic.and (Equality.gt nLambdaDoms 0) (Equality.gt nArgs 0)) ( + in (Logic.ifElse (Logic.and (Ordering.gt nLambdaDoms 0) (Ordering.gt nArgs 0)) ( let bodyRetType = Pairs.second (peelDomainsAndCod (Math.sub nLambdaDoms nArgs) resultType) funType = Lists.foldl (\c -> \d -> Core.TypeFunction (Core.FunctionType { @@ -2593,7 +2611,7 @@ rebuildApps :: Core.Term -> [Core.Term] -> Core.Type -> Core.Term rebuildApps f args fType = Logic.ifElse (Lists.null args) f (case (Strip.deannotateType fType) of - Core.TypeFunction v0 -> Optionals.fromOptional f (Optionals.map (\p -> + Core.TypeFunction v0 -> Optionals.withDefault f (Optionals.map (\p -> let arg = Pairs.first p rest = Pairs.second p remainingType = Core.functionTypeCodomain v0 @@ -2639,7 +2657,7 @@ buildReturnStmt = Syntax.BlockStatementStatement (Utils.javaReturnStatement (Just (Utils.javaConstructorCall (Utils.javaConstructorName (Syntax.Identifier recordLocalName) mTypeArgs) buildArgs Nothing))) buildMethod = - withCommentString (Strings.cat2 "Builds an immutable {@link " (Strings.cat2 recordLocalName "}.")) (Utils.methodDeclaration buildMods [] [] "build" [] recordResult (Just [ + withCommentString (Strings.concat2 "Builds an immutable {@link " (Strings.concat2 recordLocalName "}.")) (Utils.methodDeclaration buildMods [] [] "build" [] recordResult (Just [ buildReturnStmt])) builderClassDecl = Utils.javaClassDeclaration aliases tparams (Core.Name "Builder") [ @@ -2651,7 +2669,7 @@ [ buildMethod]]) builderClassMember = - withCommentString (Strings.cat2 "A fluent builder for {@link " (Strings.cat2 recordLocalName "}.")) (Syntax.ClassBodyDeclarationClassMember (Syntax.ClassMemberDeclarationClass builderClassDecl)) + withCommentString (Strings.concat2 "A fluent builder for {@link " (Strings.concat2 recordLocalName "}.")) (Syntax.ClassBodyDeclarationClassMember (Syntax.ClassMemberDeclarationClass builderClassDecl)) factoryMods = [ Syntax.MethodModifierPublic, @@ -2659,7 +2677,7 @@ factoryReturnStmt = Syntax.BlockStatementStatement (Utils.javaReturnStatement (Just (Utils.javaConstructorCall (Utils.javaConstructorName (Syntax.Identifier "Builder") mTypeArgs) [] Nothing))) factoryMethod = - withCommentString (Strings.cat2 "Creates a new fluent builder for {@link " (Strings.cat2 recordLocalName "}.")) (Utils.methodDeclaration factoryMods tparams [] "builder" [] builderResult (Just [ + withCommentString (Strings.concat2 "Creates a new fluent builder for {@link " (Strings.concat2 recordLocalName "}.")) (Utils.methodDeclaration factoryMods tparams [] "builder" [] builderResult (Just [ factoryReturnStmt])) in (Right [ factoryMethod, @@ -2741,7 +2759,7 @@ Syntax.MethodModifierPublic] anns = [] methodName = - Strings.cat2 "with" (Formatting.nonAlnumToUnderscores (Formatting.capitalize (Core.unName (Core.fieldTypeName field)))) + Strings.concat2 "with" (Formatting.nonAlnumToUnderscores (Formatting.capitalize (Core.unName (Core.fieldTypeName field)))) result = Utils.referenceTypeToResult (Utils.nameToJavaReferenceType aliases False [] elName Nothing) consId = Syntax.Identifier (Utils.sanitizeJavaName (Names.localNameOf elName)) fieldArgs = Lists.map (\f -> Utils.fieldNameToJavaExpression (Core.fieldTypeName f)) fields @@ -2768,7 +2786,7 @@ selfRefSubstitution_processGroup :: (Eq t0, Ord t0) => (M.Map t0 t0 -> t0 -> [t0] -> M.Map t0 t0) selfRefSubstitution_processGroup subst inVar outVars = - Logic.ifElse (Lists.elem inVar outVars) (Lists.foldl (\s -> \v -> Logic.ifElse (Equality.equal v inVar) s (Maps.insert v inVar s)) subst outVars) subst + Logic.ifElse (Lists.member inVar outVars) (Lists.foldl (\s -> \v -> Logic.ifElse (Equality.equal v inVar) s (Maps.insert v inVar s)) subst outVars) subst serializableTypes :: Bool -> [Syntax.InterfaceType] serializableTypes isSer = @@ -2802,7 +2820,7 @@ vd]})] (\init_ -> case init_ of Syntax.VariableInitializerExpression v0 -> let varName = javaIdentifierToString (Syntax.variableDeclaratorIdIdentifier vid) - helperName = Strings.cat2 "_init_" varName + helperName = Strings.concat2 "_init_" varName callExpr = Utils.javaMethodInvocationToJavaExpression (Utils.methodInvocation Nothing (Syntax.Identifier helperName) []) field = Syntax.InterfaceMemberDeclarationConstant (Syntax.ConstantDeclaration { @@ -2883,46 +2901,33 @@ tagCompareExpr = Utils.javaMethodInvocationToJavaExpression (Syntax.MethodInvocation { Syntax.methodInvocationHeader = (Syntax.MethodInvocation_HeaderComplex (Syntax.MethodInvocation_Complex { - Syntax.methodInvocation_ComplexVariant = (Syntax.MethodInvocation_VariantPrimary (Utils.javaMethodInvocationToJavaPrimary thisGetName)), + Syntax.methodInvocation_ComplexVariant = (Syntax.MethodInvocation_VariantType (Utils.javaTypeName (Syntax.Identifier "Integer"))), Syntax.methodInvocation_ComplexTypeArguments = [], - Syntax.methodInvocation_ComplexIdentifier = (Syntax.Identifier JavaNames.compareToMethodName)})), + Syntax.methodInvocation_ComplexIdentifier = (Syntax.Identifier "compare")})), Syntax.methodInvocationArguments = [ - Utils.javaMethodInvocationToJavaExpression otherGetName]}) + Utils.javaMethodInvocationToJavaExpression thisOrdinal, + (Utils.javaMethodInvocationToJavaExpression otherOrdinal)]}) where - thisGetClass = + thisOrdinal = Syntax.MethodInvocation { Syntax.methodInvocationHeader = (Syntax.MethodInvocation_HeaderComplex (Syntax.MethodInvocation_Complex { Syntax.methodInvocation_ComplexVariant = (Syntax.MethodInvocation_VariantPrimary (Utils.javaExpressionToJavaPrimary Utils.javaThis)), Syntax.methodInvocation_ComplexTypeArguments = [], - Syntax.methodInvocation_ComplexIdentifier = (Syntax.Identifier "getClass")})), - Syntax.methodInvocationArguments = []} - thisGetName = - Syntax.MethodInvocation { - Syntax.methodInvocationHeader = (Syntax.MethodInvocation_HeaderComplex (Syntax.MethodInvocation_Complex { - Syntax.methodInvocation_ComplexVariant = (Syntax.MethodInvocation_VariantPrimary (Utils.javaMethodInvocationToJavaPrimary thisGetClass)), - Syntax.methodInvocation_ComplexTypeArguments = [], - Syntax.methodInvocation_ComplexIdentifier = (Syntax.Identifier "getName")})), + Syntax.methodInvocation_ComplexIdentifier = (Syntax.Identifier JavaNames.hydraOrdinalMethodName)})), Syntax.methodInvocationArguments = []} - otherGetClass = + otherOrdinal = Syntax.MethodInvocation { Syntax.methodInvocationHeader = (Syntax.MethodInvocation_HeaderComplex (Syntax.MethodInvocation_Complex { Syntax.methodInvocation_ComplexVariant = (Syntax.MethodInvocation_VariantExpression (Syntax.ExpressionName { Syntax.expressionNameQualifier = Nothing, Syntax.expressionNameIdentifier = (Syntax.Identifier JavaNames.otherInstanceName)})), Syntax.methodInvocation_ComplexTypeArguments = [], - Syntax.methodInvocation_ComplexIdentifier = (Syntax.Identifier "getClass")})), - Syntax.methodInvocationArguments = []} - otherGetName = - Syntax.MethodInvocation { - Syntax.methodInvocationHeader = (Syntax.MethodInvocation_HeaderComplex (Syntax.MethodInvocation_Complex { - Syntax.methodInvocation_ComplexVariant = (Syntax.MethodInvocation_VariantPrimary (Utils.javaMethodInvocationToJavaPrimary otherGetClass)), - Syntax.methodInvocation_ComplexTypeArguments = [], - Syntax.methodInvocation_ComplexIdentifier = (Syntax.Identifier "getName")})), + Syntax.methodInvocation_ComplexIdentifier = (Syntax.Identifier JavaNames.hydraOrdinalMethodName)})), Syntax.methodInvocationArguments = []} takeTypeArgs :: String -> Int -> [Syntax.Type] -> t0 -> t1 -> Either Errors.Error [Syntax.TypeArgument] takeTypeArgs label n tyapps cx g = - Logic.ifElse (Equality.lt (Lists.length tyapps) n) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat [ + Logic.ifElse (Ordering.lt (Lists.length tyapps) n) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat [ "needed type arguments for ", label, ", found too few"])))) (Eithers.mapList (\jt -> Eithers.bind (Utils.javaTypeToJavaReferenceType jt cx) (\rt -> Right (Syntax.TypeArgumentReference rt))) (Lists.take n tyapps)) @@ -2954,10 +2959,10 @@ toDeclInit aliasesExt gExt recursiveVars flatBindings name cx g = Logic.ifElse (Sets.member name recursiveVars) ( let binding = - Optionals.fromOptional (Core.Binding { + Optionals.withDefault (Core.Binding { Core.bindingName = name, Core.bindingTerm = Core.TermUnit, - Core.bindingTypeScheme = Nothing}) (Lists.maybeHead (Lists.filter (\b -> Equality.equal (Core.bindingName b) name) flatBindings)) + Core.bindingTypeScheme = Nothing}) (Lists.head (Lists.filter (\b -> Equality.equal (Core.bindingName b) name) flatBindings)) value = Core.bindingTerm binding in (Eithers.bind (Optionals.cases (Core.bindingTypeScheme binding) (Checking.typeOfTerm cx gExt value) (\ts -> Right (Core.typeSchemeBody ts))) (\typ -> Eithers.bind (encodeType aliasesExt Sets.empty typ cx g) (\jtype -> let id = Utils.variableToJavaIdentifier name @@ -2989,10 +2994,10 @@ toDeclStatement envExt aliasesExt gExt recursiveVars thunkedVars flatBindings name cx g = let binding = - Optionals.fromOptional (Core.Binding { + Optionals.withDefault (Core.Binding { Core.bindingName = name, Core.bindingTerm = Core.TermUnit, - Core.bindingTypeScheme = Nothing}) (Lists.maybeHead (Lists.filter (\b -> Equality.equal (Core.bindingName b) name) flatBindings)) + Core.bindingTypeScheme = Nothing}) (Lists.head (Lists.filter (\b -> Equality.equal (Core.bindingName b) name) flatBindings)) value = Core.bindingTerm binding in (Eithers.bind (Optionals.cases (Core.bindingTypeScheme binding) (Checking.typeOfTerm cx gExt value) (\ts -> Right (Core.typeSchemeBody ts))) (\typ -> Eithers.bind (encodeType aliasesExt Sets.empty typ cx g) (\jtype -> let id = Utils.variableToJavaIdentifier name @@ -3050,7 +3055,7 @@ let classId = Utils.nameToJavaName aliases (elementsQualifiedName ns_) methodId = Syntax.Identifier (Utils.sanitizeJavaName localName) in (Eithers.bind (filterPhantomTypeArgs varName allTypeArgs cx g) (\filteredTypeArgs -> Eithers.bind (Eithers.mapList (\t -> Eithers.bind (encodeType aliases Sets.empty t cx g) (\jt -> Eithers.bind (Utils.javaTypeToJavaReferenceType jt cx) (\rt -> Right (Syntax.TypeArgumentReference rt)))) filteredTypeArgs) (\jTypeArgs -> - let paramNames = Lists.map (\i -> Core.Name (Strings.cat2 "p" (Literals.showInt32 i))) (Math.range 0 (Math.sub v0 1)) + let paramNames = Lists.map (\i -> Core.Name (Strings.concat2 "p" (Literals.showInt32 i))) (Math.range 0 (Math.sub v0 1)) paramExprs = Lists.map (\p -> Utils.javaIdentifierToJavaExpression (Utils.variableToJavaIdentifier p)) paramNames call = Utils.javaMethodInvocationToJavaExpression (Utils.methodInvocationStaticWithTypeArgs classId methodId jTypeArgs paramExprs) @@ -3079,8 +3084,8 @@ Core.TypeApplication v0 -> unwrapReturnType (Core.applicationTypeArgument v0) _ -> t -variantCompareToMethod :: JavaEnvironment.Aliases -> t0 -> Core.Name -> Core.Name -> [Core.FieldType] -> Syntax.ClassBodyDeclaration -variantCompareToMethod aliases tparams parentName variantName fields = +variantCompareToMethod :: JavaEnvironment.Aliases -> t0 -> Core.Name -> Core.Name -> Int -> [Core.FieldType] -> [Syntax.ClassBodyDeclaration] +variantCompareToMethod aliases tparams parentName variantName ordinal fields = let anns = [ @@ -3112,8 +3117,10 @@ Lists.concat2 [ tagDeclStmt, tagReturnStmt] valueCompareStmt - in (Utils.methodDeclaration mods [] anns JavaNames.compareToMethodName [ - param] result (Just body)) + in [ + Utils.methodDeclaration mods [] anns JavaNames.compareToMethodName [ + param] result (Just body), + (hydraOrdinalMethod (Just ordinal))] visitBranch :: JavaEnvironment.JavaEnvironment -> JavaEnvironment.Aliases -> Core.Type -> Core.Name -> Syntax.Type -> [Syntax.TypeArgument] -> Core.CaseAlternative -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error Syntax.ClassBodyDeclarationWithComments visitBranch env aliases dom tname jcod targs field cx g = @@ -3144,7 +3151,7 @@ returnStmt] in (Right (noComment (Utils.methodDeclaration mods [] anns JavaNames.visitMethodName [ param] result (Just allStmts))))))))))) - _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "visitBranch: field term is not a lambda: " (PrintCore.term (Core.caseAlternativeHandler field))))) + _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "visitBranch: field term is not a lambda: " (PrintCore.term (Core.caseAlternativeHandler field))))) withCommentString :: String -> Syntax.ClassBodyDeclaration -> Syntax.ClassBodyDeclarationWithComments withCommentString comment decl = diff --git a/src/main/haskell/Hydra/Java/Names.hs b/src/main/haskell/Hydra/Java/Names.hs --- a/src/main/haskell/Hydra/Java/Names.hs +++ b/src/main/haskell/Hydra/Java/Names.hs @@ -57,6 +57,10 @@ "hydra", "core"]) +-- | The name of the generated method returning a union variant's declared ordinal position, used to order variants consistently with Haskell's declaration-order deriving Ord (#612) +hydraOrdinalMethodName :: String +hydraOrdinalMethodName = "hydraOrdinal" + -- | The hydra.overlay.java.util package name hydraUtilPackageName :: Maybe Syntax.PackageName hydraUtilPackageName = diff --git a/src/main/haskell/Hydra/Java/Serde.hs b/src/main/haskell/Hydra/Java/Serde.hs --- a/src/main/haskell/Hydra/Java/Serde.hs +++ b/src/main/haskell/Hydra/Java/Serde.hs @@ -22,6 +22,7 @@ import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings import qualified Hydra.Names as Names import qualified Hydra.Packaging as Packaging @@ -97,10 +98,10 @@ arrayInitializerToExpr ai = let groups = Syntax.unArrayInitializer ai - in (Optionals.fromOptional (Serialization.cst "{}") (Optionals.map (\firstGroup -> Logic.ifElse (Equality.equal (Lists.length groups) 1) (Serialization.noSep [ + in (Optionals.withDefault (Serialization.cst "{}") (Optionals.map (\firstGroup -> Logic.ifElse (Equality.equal (Lists.length groups) 1) (Serialization.noSep [ Serialization.cst "{", (Serialization.commaSep Serialization.inlineStyle (Lists.map variableInitializerToExpr firstGroup)), - (Serialization.cst "}")]) (Serialization.cst "{}")) (Lists.maybeHead groups))) + (Serialization.cst "}")]) (Serialization.cst "{}")) (Lists.head groups))) arrayTypeToExpr :: Syntax.ArrayType -> Ast.Expr arrayTypeToExpr at = @@ -164,7 +165,7 @@ breakStatementToExpr bs = let mlabel = Syntax.unBreakStatement bs - in (Serialization.withSemi (Serialization.spaceSep (Optionals.cat [ + in (Serialization.withSemi (Serialization.spaceSep (Optionals.givens [ Just (Serialization.cst "break"), (Optionals.map identifierToExpr mlabel)]))) @@ -196,7 +197,7 @@ let rt = Syntax.castExpression_RefAndBoundsType rab adds = Syntax.castExpression_RefAndBoundsBounds rab in (Serialization.parenList False [ - Serialization.spaceSep (Optionals.cat [ + Serialization.spaceSep (Optionals.givens [ Just (referenceTypeToExpr rt), (Logic.ifElse (Lists.null adds) Nothing (Just (Serialization.spaceSep (Lists.map additionalBoundToExpr adds))))])]) @@ -282,7 +283,7 @@ let ids = Syntax.classOrInterfaceTypeToInstantiateIdentifiers coitti margs = Syntax.classOrInterfaceTypeToInstantiateTypeArguments coitti - in (Serialization.noSep (Optionals.cat [ + in (Serialization.noSep (Optionals.givens [ Just (Serialization.dotSep (Lists.map annotatedIdentifierToExpr ids)), (Optionals.map typeArgumentsOrDiamondToExpr margs)])) @@ -302,8 +303,8 @@ Syntax.ClassTypeQualifierParent v0 -> Serialization.dotSep [ classOrInterfaceTypeToExpr v0, (typeIdentifierToExpr id)] - in (Serialization.noSep (Optionals.cat [ - Just (Serialization.spaceSep (Optionals.cat [ + in (Serialization.noSep (Optionals.givens [ + Just (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null anns) Nothing (Just (Serialization.commaSep Serialization.inlineStyle (Lists.map annotationToExpr anns))), (Just qualifiedId)])), (Logic.ifElse (Lists.null args) Nothing (Just (Serialization.angleBracesList Serialization.inlineStyle (Lists.map typeArgumentToExpr args))))])) @@ -321,7 +322,7 @@ Logic.ifElse (Lists.null imports) Nothing (Just (Serialization.newlineSep (Lists.map importDeclarationToExpr imports))) typesSec = Logic.ifElse (Lists.null types) Nothing (Just (Serialization.doubleNewlineSep (Lists.map typeDeclarationWithCommentsToExpr types))) - in (Serialization.doubleNewlineSep (Optionals.cat [ + in (Serialization.doubleNewlineSep (Optionals.givens [ warning, pkgSec, importsSec, @@ -354,7 +355,7 @@ let mods = Syntax.constantDeclarationModifiers cd typ = Syntax.constantDeclarationType cd vars = Syntax.constantDeclarationVariables cd - in (Serialization.withSemi (Serialization.spaceSep (Optionals.cat [ + in (Serialization.withSemi (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null mods) Nothing (Just (Serialization.spaceSep (Lists.map constantModifierToExpr mods))), (Just (unannTypeToExpr typ)), (Just (Serialization.commaSep Serialization.inlineStyle (Lists.map variableDeclaratorToExpr vars)))]))) @@ -367,7 +368,7 @@ let minvoc = Syntax.constructorBodyInvocation cb stmts = Syntax.constructorBodyStatements cb - in (Serialization.curlyBlock Serialization.fullBlockStyle (Serialization.doubleNewlineSep (Optionals.cat [ + in (Serialization.curlyBlock Serialization.fullBlockStyle (Serialization.doubleNewlineSep (Optionals.givens [ Optionals.map explicitConstructorInvocationToExpr minvoc, (Just (Serialization.newlineSep (Lists.map blockStatementToExpr stmts)))]))) @@ -378,7 +379,7 @@ cons = Syntax.constructorDeclarationConstructor cd mthrows = Syntax.constructorDeclarationThrows cd body = Syntax.constructorDeclarationBody cd - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null mods) Nothing (Just (Serialization.spaceSep (Lists.map constructorModifierToExpr mods))), (Just (constructorDeclaratorToExpr cons)), (Optionals.map throwsToExpr mthrows), @@ -390,7 +391,7 @@ let tparams = Syntax.constructorDeclaratorParameters cd name = Syntax.constructorDeclaratorName cd fparams = Syntax.constructorDeclaratorFormalParameters cd - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null tparams) Nothing (Just (Serialization.angleBracesList Serialization.inlineStyle (Lists.map typeParameterToExpr tparams))), (Just (simpleTypeNameToExpr name)), (Just (Serialization.parenListAdaptive (Lists.map formalParameterToExpr fparams)))])) @@ -407,7 +408,7 @@ continueStatementToExpr cs = let mlabel = Syntax.unContinueStatement cs - in (Serialization.withSemi (Serialization.spaceSep (Optionals.cat [ + in (Serialization.withSemi (Serialization.spaceSep (Optionals.givens [ Just (Serialization.cst "continue"), (Optionals.map identifierToExpr mlabel)]))) @@ -453,7 +454,7 @@ let mqual = Syntax.expressionNameQualifier en id = Syntax.expressionNameIdentifier en - in (Serialization.dotSep (Optionals.cat [ + in (Serialization.dotSep (Optionals.givens [ Optionals.map ambiguousNameToExpr mqual, (Just (identifierToExpr id))])) @@ -489,7 +490,7 @@ let mods = Syntax.fieldDeclarationModifiers fd typ = Syntax.fieldDeclarationUnannType fd vars = Syntax.fieldDeclarationVariableDeclarators fd - in (Serialization.withSemi (Serialization.spaceSep (Optionals.cat [ + in (Serialization.withSemi (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null mods) Nothing (Just (Serialization.spaceSep (Lists.map fieldModifierToExpr mods))), (Just (unannTypeToExpr typ)), (Just (Serialization.commaSep Serialization.inlineStyle (Lists.map variableDeclaratorToExpr vars)))]))) @@ -525,7 +526,7 @@ let mods = Syntax.formalParameter_SimpleModifiers fps typ = Syntax.formalParameter_SimpleType fps id = Syntax.formalParameter_SimpleId fps - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null mods) Nothing (Just (Serialization.spaceSep (Lists.map variableModifierToExpr mods))), (Just (unannTypeToExpr typ)), (Just (variableDeclaratorIdToExpr id))])) @@ -574,8 +575,8 @@ integerLiteralToExpr il = let i = Syntax.unIntegerLiteral il - suffix = Logic.ifElse (Logic.or (Equality.gt i 2147483647) (Equality.lt i (-2147483648))) "L" "" - in (Serialization.cst (Strings.cat2 (Literals.showBigint i) suffix)) + suffix = Logic.ifElse (Logic.or (Ordering.gt i 2147483647) (Ordering.lt i (-2147483648))) "L" "" + in (Serialization.cst (Strings.concat2 (Literals.showBigint i) suffix)) integralTypeToExpr :: Syntax.IntegralType -> Ast.Expr integralTypeToExpr t = @@ -617,7 +618,7 @@ let mods = Syntax.interfaceMethodDeclarationModifiers imd header = Syntax.interfaceMethodDeclarationHeader imd body = Syntax.interfaceMethodDeclarationBody imd - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null mods) Nothing (Just (Serialization.spaceSep (Lists.map interfaceMethodModifierToExpr mods))), (Just (methodHeaderToExpr header)), (Just (methodBodyToExpr body))])) @@ -651,14 +652,14 @@ javaDocEntityRef :: Packaging.EntityReference -> String javaDocEntityRef ref = case ref of - Packaging.EntityReferenceDefinition v0 -> Strings.cat2 "{@code " (Strings.cat2 (case v0 of + Packaging.EntityReferenceDefinition v0 -> Strings.concat2 "{@code " (Strings.concat2 (case v0 of Packaging.DefinitionReferencePrimitive v1 -> Names.localNameOf v1 Packaging.DefinitionReferenceTerm v1 -> Names.localNameOf v1 Packaging.DefinitionReferenceType v1 -> Names.localNameOf v1) "}") - Packaging.EntityReferenceModule v0 -> Strings.cat2 "" (Packaging.unModuleName v0) - Packaging.EntityReferencePackage v0 -> Strings.cat2 "" (Packaging.unPackageName v0) - Packaging.EntityReferenceTermExpr v0 -> Strings.cat2 "{@code " (Strings.cat2 v0 "}") - Packaging.EntityReferenceTypeExpr v0 -> Strings.cat2 "{@code " (Strings.cat2 v0 "}") + Packaging.EntityReferenceModule v0 -> Strings.concat2 "" (Packaging.unModuleName v0) + Packaging.EntityReferencePackage v0 -> Strings.concat2 "" (Packaging.unPackageName v0) + Packaging.EntityReferenceTermExpr v0 -> Strings.concat2 "{@code " (Strings.concat2 v0 "}") + Packaging.EntityReferenceTypeExpr v0 -> Strings.concat2 "{@code " (Strings.concat2 v0 "}") javaFloatLiteralText :: String -> String javaFloatLiteralText s = @@ -702,7 +703,7 @@ Syntax.LiteralBoolean v0 -> Serialization.cst (Logic.ifElse v0 "true" "false") Syntax.LiteralCharacter v0 -> let ci = Literals.bigintToInt32 (Literals.uint16ToBigint v0) - in (Serialization.cst (Strings.cat2 "'" (Strings.cat2 (Logic.ifElse (Equality.equal ci 39) "\\'" (Logic.ifElse (Equality.equal ci 92) "\\\\" (Logic.ifElse (Equality.equal ci 10) "\\n" (Logic.ifElse (Equality.equal ci 13) "\\r" (Logic.ifElse (Equality.equal ci 9) "\\t" (Logic.ifElse (Logic.and (Equality.gte ci 32) (Equality.lt ci 127)) (Strings.fromList [ + in (Serialization.cst (Strings.concat2 "'" (Strings.concat2 (Logic.ifElse (Equality.equal ci 39) "\\'" (Logic.ifElse (Equality.equal ci 92) "\\\\" (Logic.ifElse (Equality.equal ci 10) "\\n" (Logic.ifElse (Equality.equal ci 13) "\\r" (Logic.ifElse (Equality.equal ci 9) "\\t" (Logic.ifElse (Logic.and (Ordering.gte ci 32) (Ordering.lt ci 127)) (Strings.fromList [ ci]) (Serde.javaUnicodeEscape ci))))))) "'"))) Syntax.LiteralString v0 -> stringLiteralToExpr v0 @@ -722,7 +723,7 @@ let mods = Syntax.localVariableDeclarationModifiers lvd t = Syntax.localVariableDeclarationType lvd decls = Syntax.localVariableDeclarationDeclarators lvd - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null mods) Nothing (Just (Serialization.spaceSep (Lists.map variableModifierToExpr mods))), (Just (localNameToExpr t)), (Just (Serialization.commaSep Serialization.inlineStyle (Lists.map variableDeclaratorToExpr decls)))])) @@ -744,11 +745,11 @@ header = Syntax.methodDeclarationHeader md body = Syntax.methodDeclarationBody md headerAndBody = - Serialization.spaceSep (Optionals.cat [ + Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null mods) Nothing (Just (Serialization.spaceSep (Lists.map methodModifierToExpr mods))), (Just (methodHeaderToExpr header)), (Just (methodBodyToExpr body))]) - in (Serialization.newlineSep (Optionals.cat [ + in (Serialization.newlineSep (Optionals.givens [ Logic.ifElse (Lists.null anns) Nothing (Just (Serialization.newlineSep (Lists.map annotationToExpr anns))), (Just headerAndBody)])) @@ -768,7 +769,7 @@ result = Syntax.methodHeaderResult mh decl = Syntax.methodHeaderDeclarator mh mthrows = Syntax.methodHeaderThrows mh - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null params) Nothing (Just (Serialization.angleBracesList Serialization.inlineStyle (Lists.map typeParameterToExpr params))), (Just (resultToExpr result)), (Just (methodDeclaratorToExpr decl)), @@ -788,7 +789,7 @@ targs = Syntax.methodInvocation_ComplexTypeArguments v0 cid = Syntax.methodInvocation_ComplexIdentifier v0 idSec = - Serialization.noSep (Optionals.cat [ + Serialization.noSep (Optionals.givens [ Logic.ifElse (Lists.null targs) Nothing (Just (Serialization.angleBracesList Serialization.inlineStyle (Lists.map typeArgumentToExpr targs))), (Just (identifierToExpr cid))]) in case cvar of @@ -858,10 +859,10 @@ msuperc = Syntax.normalClassDeclarationExtends ncd superi = Syntax.normalClassDeclarationImplements ncd body = Syntax.normalClassDeclarationBody ncd - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null mods) Nothing (Just (Serialization.spaceSep (Lists.map classModifierToExpr mods))), (Just (Serialization.cst "class")), - (Just (Serialization.noSep (Optionals.cat [ + (Just (Serialization.noSep (Optionals.givens [ Just (typeIdentifierToExpr id), (Logic.ifElse (Lists.null tparams) Nothing (Just (Serialization.angleBracesList Serialization.inlineStyle (Lists.map typeParameterToExpr tparams))))]))), (Optionals.map (\c -> Serialization.spaceSep [ @@ -880,10 +881,10 @@ tparams = Syntax.normalInterfaceDeclarationParameters nid extends = Syntax.normalInterfaceDeclarationExtends nid body = Syntax.normalInterfaceDeclarationBody nid - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null mods) Nothing (Just (Serialization.spaceSep (Lists.map interfaceModifierToExpr mods))), (Just (Serialization.cst "interface")), - (Just (Serialization.noSep (Optionals.cat [ + (Just (Serialization.noSep (Optionals.givens [ Just (typeIdentifierToExpr id), (Logic.ifElse (Lists.null tparams) Nothing (Just (Serialization.angleBracesList Serialization.inlineStyle (Lists.map typeParameterToExpr tparams))))]))), (Logic.ifElse (Lists.null extends) Nothing (Just (Serialization.spaceSep [ @@ -902,11 +903,11 @@ let mods = Syntax.packageDeclarationModifiers pd ids = Syntax.packageDeclarationIdentifiers pd - in (Serialization.withSemi (Serialization.spaceSep (Optionals.cat [ + in (Serialization.withSemi (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null mods) Nothing (Just (Serialization.spaceSep (Lists.map packageModifierToExpr mods))), (Just (Serialization.spaceSep [ Serialization.cst "package", - (Serialization.cst (Strings.intercalate "." (Lists.map (\id -> Syntax.unIdentifier id) ids)))]))]))) + (Serialization.cst (Strings.join "." (Lists.map (\id -> Syntax.unIdentifier id) ids)))]))]))) packageModifierToExpr :: Syntax.PackageModifier -> Ast.Expr packageModifierToExpr pm = annotationToExpr (Syntax.unPackageModifier pm) @@ -971,7 +972,7 @@ let pt = Syntax.primitiveTypeWithAnnotationsType ptwa anns = Syntax.primitiveTypeWithAnnotationsAnnotations ptwa - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null anns) Nothing (Just (Serialization.spaceSep (Lists.map annotationToExpr anns))), (Just (primitiveTypeToExpr pt))])) @@ -1030,14 +1031,14 @@ returnStatementToExpr rs = let mex = Syntax.unReturnStatement rs - in (Serialization.withSemi (Serialization.spaceSep (Optionals.cat [ + in (Serialization.withSemi (Serialization.spaceSep (Optionals.givens [ Just (Serialization.cst "return"), (Optionals.map expressionToExpr mex)]))) -- | Sanitize a string for use in a Java comment sanitizeJavaComment :: String -> String sanitizeJavaComment s = - Strings.intercalate ">" (Strings.splitOn ">" (Strings.intercalate "<" (Strings.splitOn "<" (Strings.intercalate "&" (Strings.splitOn "&" s))))) + Strings.join ">" (Strings.splitOn ">" (Strings.join "<" (Strings.splitOn "<" (Strings.join "&" (Strings.splitOn "&" s))))) shiftExpressionToExpr :: Syntax.ShiftExpression -> Ast.Expr shiftExpressionToExpr e = @@ -1065,7 +1066,7 @@ singleLineComment c = let sanitized = sanitizeJavaComment c - in (Serialization.cst (Logic.ifElse (Equality.equal sanitized "") "//" (Strings.cat2 "// " sanitized))) + in (Serialization.cst (Logic.ifElse (Equality.equal sanitized "") "//" (Strings.concat2 "// " sanitized))) statementExpressionToExpr :: Syntax.StatementExpression -> Ast.Expr statementExpressionToExpr e = @@ -1112,7 +1113,7 @@ stringLiteralToExpr sl = let s = Syntax.unStringLiteral sl - in (Serialization.cst (Strings.cat2 "\"" (Strings.cat2 (Serde.escapeJavaString s) "\""))) + in (Serialization.cst (Strings.concat2 "\"" (Strings.concat2 (Serde.escapeJavaString s) "\""))) switchStatementToExpr :: t0 -> Ast.Expr switchStatementToExpr _ = Serialization.cst "STUB:SwitchStatement" @@ -1175,7 +1176,7 @@ let id = Syntax.typeNameIdentifier tn mqual = Syntax.typeNameQualifier tn - in (Serialization.dotSep (Optionals.cat [ + in (Serialization.dotSep (Optionals.givens [ Optionals.map packageOrTypeNameToExpr mqual, (Just (typeIdentifierToExpr id))])) @@ -1188,7 +1189,7 @@ let mods = Syntax.typeParameterModifiers tp id = Syntax.typeParameterIdentifier tp bound = Syntax.typeParameterBound tp - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null mods) Nothing (Just (Serialization.spaceSep (Lists.map typeParameterModifierToExpr mods))), (Just (typeIdentifierToExpr id)), (Optionals.map (\b -> Serialization.spaceSep [ @@ -1206,7 +1207,7 @@ let anns = Syntax.typeVariableAnnotations tv id = Syntax.typeVariableIdentifier tv - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null anns) Nothing (Just (Serialization.spaceSep (Lists.map annotationToExpr anns))), (Just (typeIdentifierToExpr id))])) @@ -1245,7 +1246,7 @@ cit = Syntax.unqualifiedClassInstanceCreationExpressionClassOrInterface ucice args = Syntax.unqualifiedClassInstanceCreationExpressionArguments ucice mbody = Syntax.unqualifiedClassInstanceCreationExpressionBody ucice - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Just (Serialization.cst "new"), (Logic.ifElse (Lists.null targs) Nothing (Just (Serialization.angleBracesList Serialization.inlineStyle (Lists.map typeArgumentToExpr targs)))), (Just (Serialization.noSep [ @@ -1261,7 +1262,7 @@ let id = Syntax.variableDeclaratorIdIdentifier vdi mdims = Syntax.variableDeclaratorIdDims vdi - in (Serialization.noSep (Optionals.cat [ + in (Serialization.noSep (Optionals.givens [ Just (identifierToExpr id), (Optionals.map dimsToExpr mdims)])) @@ -1312,7 +1313,7 @@ let anns = Syntax.wildcardAnnotations w mbounds = Syntax.wildcardWildcard w - in (Serialization.spaceSep (Optionals.cat [ + in (Serialization.spaceSep (Optionals.givens [ Logic.ifElse (Lists.null anns) Nothing (Just (Serialization.commaSep Serialization.inlineStyle (Lists.map annotationToExpr anns))), (Just (Serialization.cst "*")), (Optionals.map wildcardBoundsToExpr mbounds)])) @@ -1321,5 +1322,5 @@ withComments :: Maybe String -> Ast.Expr -> Ast.Expr withComments mc expr = Optionals.cases mc expr (\c -> Serialization.newlineSep [ - Serialization.cst (Strings.cat2 "/**\n" (Strings.cat2 (Strings.intercalate "\n" (Lists.map (\l -> Logic.ifElse (Equality.equal l "") " *" (Strings.cat2 " * " l)) (Strings.lines (sanitizeJavaComment (Docs.renderDocStringWith javaDocEntityRef c))))) "\n */")), + Serialization.cst (Strings.concat2 "/**\n" (Strings.concat2 (Strings.join "\n" (Lists.map (\l -> Logic.ifElse (Equality.equal l "") " *" (Strings.concat2 " * " l)) (Strings.lines (sanitizeJavaComment (Docs.renderDocStringWith javaDocEntityRef c))))) "\n */")), expr]) diff --git a/src/main/haskell/Hydra/Java/Testing.hs b/src/main/haskell/Hydra/Java/Testing.hs --- a/src/main/haskell/Hydra/Java/Testing.hs +++ b/src/main/haskell/Hydra/Java/Testing.hs @@ -48,8 +48,8 @@ let ns_ = Packaging.moduleName testModule parts = Strings.splitOn "." (Packaging.unModuleName ns_) - packageName = Strings.intercalate "." (Optionals.fromOptional [] (Lists.maybeInit parts)) - className_ = Strings.cat2 (Formatting.capitalize (Optionals.fromOptional "" (Lists.maybeLast parts))) "Test" + packageName = Strings.join "." (Optionals.withDefault [] (Lists.init parts)) + className_ = Strings.concat2 (Formatting.capitalize (Optionals.withDefault "" (Lists.last parts))) "Test" groupName_ = Testing.testGroupName testGroup standardImports = [ @@ -58,22 +58,22 @@ "import java.util.*;", "import hydra.overlay.java.util.*;"] header = - Strings.cat [ - Strings.cat2 "// " Constants.warningAutoGeneratedFile, + Strings.concat [ + Strings.concat2 "// " Constants.warningAutoGeneratedFile, "\n", - (Strings.cat2 "// " groupName_), + (Strings.concat2 "// " groupName_), "\n\n", - (Strings.cat [ + (Strings.concat [ "package ", packageName, ";\n\n"]), - (Strings.intercalate "\n" standardImports), + (Strings.join "\n" standardImports), "\n\n", - (Strings.cat [ + (Strings.concat [ "public class ", className_, " {\n\n"])] - in (Strings.cat [ + in (Strings.concat [ header, testBody, "\n}\n"]) @@ -91,10 +91,10 @@ formatJavaTestName name = let replaced = - Strings.intercalate " Neg" (Strings.splitOn "-" (Strings.intercalate "Dot" (Strings.splitOn "." (Strings.intercalate " Plus" (Strings.splitOn "+" (Strings.intercalate " Div" (Strings.splitOn "/" (Strings.intercalate " Mul" (Strings.splitOn "*" (Strings.intercalate " Num" (Strings.splitOn "#" name))))))))))) + Strings.join " Neg" (Strings.splitOn "-" (Strings.join "Dot" (Strings.splitOn "." (Strings.join " Plus" (Strings.splitOn "+" (Strings.join " Div" (Strings.splitOn "/" (Strings.join " Mul" (Strings.splitOn "*" (Strings.join " Num" (Strings.splitOn "#" name))))))))))) sanitized = Formatting.nonAlnumToUnderscores replaced pascal_ = Formatting.convertCase Util.CaseConventionLowerSnake Util.CaseConventionPascal sanitized - in (Strings.cat2 "test" pascal_) + in (Strings.concat2 "test" pascal_) -- | Generate a single JUnit test case from a test case with metadata generateJavaTestCase :: [String] -> Testing.TestCaseWithMetadata -> Either t0 [String] @@ -106,21 +106,21 @@ Testing.TestCaseUniversal v0 -> let actual_ = Testing.universalTestCaseActual v0 () expected_ = Testing.universalTestCaseExpected v0 () - fullName = Logic.ifElse (Lists.null groupPath) name_ (Strings.intercalate "_" (Lists.concat2 groupPath [ + fullName = Logic.ifElse (Lists.null groupPath) name_ (Strings.join "_" (Lists.concat2 groupPath [ name_])) formattedName = formatJavaTestName fullName in (Right [ " @Test", - (Strings.cat [ + (Strings.concat [ " public void ", formattedName, "() {"]), " assertEquals(", - (Strings.cat [ + (Strings.concat [ " ", expected_, ","]), - (Strings.cat [ + (Strings.concat [ " ", actual_, ");"]), @@ -136,13 +136,13 @@ let cases_ = Testing.testGroupCases testGroup subgroups = Testing.testGroupSubgroups testGroup - in (Eithers.bind (Eithers.map (\lines_ -> Strings.intercalate "\n\n" (Lists.concat lines_)) (Eithers.mapList (\tc -> generateJavaTestCase groupPath tc) cases_)) (\testCasesStr -> Eithers.map (\subgroupsStr -> Strings.cat [ + in (Eithers.bind (Eithers.map (\lines_ -> Strings.join "\n\n" (Lists.concat lines_)) (Eithers.mapList (\tc -> generateJavaTestCase groupPath tc) cases_)) (\testCasesStr -> Eithers.map (\subgroupsStr -> Strings.concat [ testCasesStr, (Logic.ifElse (Logic.or (Equality.equal testCasesStr "") (Equality.equal subgroupsStr "")) "" "\n\n"), - subgroupsStr]) (Eithers.map (\blocks -> Strings.intercalate "\n\n" blocks) (Eithers.mapList (\subgroup -> + subgroupsStr]) (Eithers.map (\blocks -> Strings.join "\n\n" blocks) (Eithers.mapList (\subgroup -> let groupName = Testing.testGroupName subgroup - header = Strings.cat2 " // " groupName - in (Eithers.map (\content -> Strings.cat [ + header = Strings.concat2 " // " groupName + in (Eithers.map (\content -> Strings.concat [ header, "\n\n", content]) (generateJavaTestGroupHierarchy (Lists.concat2 groupPath [ @@ -155,12 +155,12 @@ let testModuleContent = buildJavaTestModule testModule testGroup testBody ns_ = Packaging.moduleName testModule parts = Strings.splitOn "." (Packaging.unModuleName ns_) - dirParts = Lists.drop 1 (Optionals.fromOptional [] (Lists.maybeInit parts)) - className_ = Strings.cat2 (Formatting.capitalize (Optionals.fromOptional "" (Lists.maybeLast parts))) "Test" - fileName = Strings.cat2 className_ ".java" + dirParts = Lists.drop 1 (Optionals.withDefault [] (Lists.init parts)) + className_ = Strings.concat2 (Formatting.capitalize (Optionals.withDefault "" (Lists.last parts))) "Test" + fileName = Strings.concat2 className_ ".java" filePath = - Strings.cat [ - Strings.intercalate "/" dirParts, + Strings.concat [ + Strings.join "/" dirParts, "/", fileName] in (filePath, testModuleContent)) (generateJavaTestGroupHierarchy [] testGroup) @@ -168,4 +168,4 @@ -- | Convert namespace to Java class name namespaceToJavaClassName :: Packaging.ModuleName -> String namespaceToJavaClassName ns_ = - Strings.intercalate "." (Lists.map Formatting.capitalize (Strings.splitOn "." (Packaging.unModuleName ns_))) + Strings.join "." (Lists.map Formatting.capitalize (Strings.splitOn "." (Packaging.unModuleName ns_))) diff --git a/src/main/haskell/Hydra/Java/Utils.hs b/src/main/haskell/Hydra/Java/Utils.hs --- a/src/main/haskell/Hydra/Java/Utils.hs +++ b/src/main/haskell/Hydra/Java/Utils.hs @@ -57,7 +57,7 @@ Syntax.MultiplicativeExpressionUnary (Syntax.UnaryExpressionOther (Syntax.UnaryExpressionNotPlusMinusPostfix (Syntax.PostfixExpressionPrimary (Syntax.PrimaryNoNewArray (Syntax.PrimaryNoNewArrayExpressionLiteral (Syntax.LiteralInteger (Syntax.IntegerLiteral 0))))))) in (Lists.foldl (\ae -> \me -> Syntax.AdditiveExpressionPlus (Syntax.AdditiveExpression_Binary { Syntax.additiveExpression_BinaryLhs = ae, - Syntax.additiveExpression_BinaryRhs = me})) (Syntax.AdditiveExpressionUnary (Optionals.fromOptional dummyMult (Lists.maybeHead exprs))) (Lists.drop 1 exprs)) + Syntax.additiveExpression_BinaryRhs = me})) (Syntax.AdditiveExpressionUnary (Optionals.withDefault dummyMult (Lists.head exprs))) (Lists.drop 1 exprs)) addInScopeVar :: Core.Name -> Environment.Aliases -> Environment.Aliases addInScopeVar name aliases = @@ -176,7 +176,7 @@ Syntax.interfaceMethodDeclarationBody = (javaMethodBody stmts)}) isEscaped :: String -> Bool -isEscaped s = Equality.equal (Optionals.fromOptional 0 (Strings.maybeCharAt 0 s)) 36 +isEscaped s = Equality.equal (Optionals.withDefault 0 (Strings.charAt 0 s)) 36 javaAdditiveExpressionToJavaExpression :: Syntax.AdditiveExpression -> Syntax.Expression javaAdditiveExpressionToJavaExpression ae = @@ -364,15 +364,15 @@ Syntax.AssignmentExpressionConditional v1 -> case v1 of Syntax.ConditionalExpressionSimple v2 -> let cands = Syntax.unConditionalOrExpression v2 - in (Optionals.fromOptional fallback (Optionals.bind (Lists.maybeHead cands) (\candHead -> + in (Optionals.withDefault fallback (Optionals.bind (Lists.head cands) (\candHead -> let iors = Syntax.unConditionalAndExpression candHead - in (Optionals.bind (Lists.maybeHead iors) (\iorHead -> + in (Optionals.bind (Lists.head iors) (\iorHead -> let xors = Syntax.unInclusiveOrExpression iorHead - in (Optionals.bind (Lists.maybeHead xors) (\xorHead -> + in (Optionals.bind (Lists.head xors) (\xorHead -> let ands = Syntax.unExclusiveOrExpression xorHead - in (Optionals.bind (Lists.maybeHead ands) (\andHead -> + in (Optionals.bind (Lists.head ands) (\andHead -> let eqs = Syntax.unAndExpression andHead - in (Optionals.bind (Lists.maybeHead eqs) (\eqHead -> Just (case eqHead of + in (Optionals.bind (Lists.head eqs) (\eqHead -> Just (case eqHead of Syntax.EqualityExpressionUnary v3 -> case v3 of Syntax.RelationalExpressionSimple v4 -> case v4 of Syntax.ShiftExpressionUnary v5 -> case v5 of @@ -844,7 +844,7 @@ Optionals.cases (Maps.lookup gname (Environment.aliasesPackages aliases)) (Strings.splitOn "." (Packaging.unModuleName gname)) (\pkgName -> Lists.map (\i -> Syntax.unIdentifier i) (Syntax.unPackageName pkgName)) allParts = Lists.concat2 parts [ sanitizeJavaName local] - in (Syntax.Identifier (Strings.intercalate "." allParts))))) + in (Syntax.Identifier (Strings.join "." allParts))))) nameToJavaReferenceType :: Environment.Aliases -> Bool -> [Syntax.TypeArgument] -> Core.Name -> Maybe String -> Syntax.ReferenceType nameToJavaReferenceType aliases qualify args name mlocal = @@ -864,7 +864,7 @@ pkg = Logic.ifElse qualify (Optionals.cases alias Syntax.ClassTypeQualifierNone (\p -> Syntax.ClassTypeQualifierPackage p)) Syntax.ClassTypeQualifierNone jid = - javaTypeIdentifier (Optionals.cases mlocal (sanitizeJavaName local) (\l -> Strings.cat2 (Strings.cat2 (sanitizeJavaName local) ".") (sanitizeJavaName l))) + javaTypeIdentifier (Optionals.cases mlocal (sanitizeJavaName local) (\l -> Strings.concat2 (Strings.concat2 (sanitizeJavaName local) ".") (sanitizeJavaName l))) in (jid, pkg) overlayJavaLibPackageAliases :: M.Map Packaging.ModuleName Syntax.PackageName @@ -911,6 +911,14 @@ "lib", "files"])), ( + Packaging.ModuleName "hydra.lib.functions", + (JavaNames.javaPackageName [ + "hydra", + "overlay", + "java", + "lib", + "functions"])), + ( Packaging.ModuleName "hydra.lib.hashing", (JavaNames.javaPackageName [ "hydra", @@ -967,6 +975,14 @@ "lib", "optionals"])), ( + Packaging.ModuleName "hydra.lib.ordering", + (JavaNames.javaPackageName [ + "hydra", + "overlay", + "java", + "lib", + "ordering"])), + ( Packaging.ModuleName "hydra.lib.pairs", (JavaNames.javaPackageName [ "hydra", @@ -1113,7 +1129,7 @@ uniqueVarName_go :: Environment.Aliases -> String -> Int -> Core.Name uniqueVarName_go aliases base n = - let candidate = Core.Name (Strings.cat2 base (Literals.showInt32 n)) + let candidate = Core.Name (Strings.concat2 base (Literals.showInt32 n)) in (Logic.ifElse (Sets.member candidate (Environment.aliasesInScopeJavaVars aliases)) (uniqueVarName_go aliases base (Math.add n 1)) candidate) varDeclarationStatement :: Syntax.Identifier -> Syntax.Expression -> Syntax.BlockStatement @@ -1149,7 +1165,7 @@ local = Util.qualifiedNameLocal qn flocal = Formatting.capitalize (Core.unName fname) local1 = - Logic.ifElse qualify (Strings.cat2 (Strings.cat2 local ".") flocal) (Logic.ifElse (Equality.equal flocal local) (Strings.cat2 flocal "_") flocal) + Logic.ifElse qualify (Strings.concat2 (Strings.concat2 local ".") flocal) (Logic.ifElse (Equality.equal flocal local) (Strings.concat2 flocal "_") flocal) in (Names.unqualifyName (Util.QualifiedName { Util.qualifiedNameModuleName = ns_, Util.qualifiedNameLocal = local1}))