module Hydra.Ext.Java.Coder (
JavaFeatures(..),
java8Features,
moduleToJava,
) where
import Hydra.Kernel
import Hydra.Reduction
import Hydra.Ext.Java.Utils
import Hydra.Ext.Java.Language
import Hydra.Ext.Java.Names
import Hydra.Adapters
import Hydra.Tools.Serialization
import Hydra.Ext.Java.Serde
import Hydra.Ext.Java.Settings
import Hydra.AdapterUtils
import qualified Hydra.Dsl.Terms as Terms
import qualified Hydra.Dsl.Types as Types
import qualified Hydra.Ext.Java.Syntax as Java
import Hydra.Lib.Io
import qualified Control.Monad as CM
import qualified Data.List as L
import qualified Data.List.Split as LS
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Maybe as Y
import Data.String (String)
data JavaSymbolClass = JavaSymbolClassConstant | JavaSymbolClassNullaryFunction | JavaSymbolClassUnaryFunction | JavaSymbolLocalVariable
data JavaFeatures = JavaFeatures {
JavaFeatures -> Bool
supportsDiamondOperator :: Bool
}
java8Features :: JavaFeatures
java8Features = JavaFeatures {
supportsDiamondOperator :: Bool
supportsDiamondOperator = Bool
False
}
java11Features :: JavaFeatures
java11Features = JavaFeatures {
supportsDiamondOperator :: Bool
supportsDiamondOperator = Bool
True
}
javaFeatures :: JavaFeatures
javaFeatures = JavaFeatures
java11Features
moduleToJava :: Module -> Flow Graph (M.Map FilePath String)
moduleToJava :: Module -> Flow Graph (Map FilePath FilePath)
moduleToJava Module
mod = FilePath
-> Flow Graph (Map FilePath FilePath)
-> Flow Graph (Map FilePath FilePath)
forall s a. FilePath -> Flow s a -> Flow s a
withTrace FilePath
"encode module in Java" (Flow Graph (Map FilePath FilePath)
-> Flow Graph (Map FilePath FilePath))
-> Flow Graph (Map FilePath FilePath)
-> Flow Graph (Map FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ do
Map Name CompilationUnit
units <- Module -> Flow Graph (Map Name CompilationUnit)
moduleToJavaCompilationUnit Module
mod
Map FilePath FilePath -> Flow Graph (Map FilePath FilePath)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FilePath FilePath -> Flow Graph (Map FilePath FilePath))
-> Map FilePath FilePath -> Flow Graph (Map FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FilePath, FilePath)] -> Map FilePath FilePath)
-> [(FilePath, FilePath)] -> Map FilePath FilePath
forall a b. (a -> b) -> a -> b
$ (Name, CompilationUnit) -> (FilePath, FilePath)
forPair ((Name, CompilationUnit) -> (FilePath, FilePath))
-> [(Name, CompilationUnit)] -> [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name CompilationUnit -> [(Name, CompilationUnit)]
forall k a. Map k a -> [(k, a)]
M.toList Map Name CompilationUnit
units
where
forPair :: (Name, CompilationUnit) -> (FilePath, FilePath)
forPair (Name
name, CompilationUnit
unit) = (Name -> FilePath
elementNameToFilePath Name
name, Expr -> FilePath
printExpr (Expr -> FilePath) -> Expr -> FilePath
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
parenthesize (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ CompilationUnit -> Expr
writeCompilationUnit CompilationUnit
unit)
adaptTypeToJavaAndEncode :: Aliases -> Type -> Flow Graph Java.Type
adaptTypeToJavaAndEncode :: Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases = Language -> (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall t.
Language -> (Type -> Flow Graph t) -> Type -> Flow Graph t
adaptAndEncodeType Language
javaLanguage (Aliases -> Type -> Flow Graph Type
encodeType Aliases
aliases)
addComment :: Java.ClassBodyDeclaration -> FieldType -> Flow Graph Java.ClassBodyDeclarationWithComments
ClassBodyDeclaration
decl FieldType
field = ClassBodyDeclaration
-> Maybe FilePath -> ClassBodyDeclarationWithComments
Java.ClassBodyDeclarationWithComments ClassBodyDeclaration
decl (Maybe FilePath -> ClassBodyDeclarationWithComments)
-> Flow Graph (Maybe FilePath)
-> Flow Graph ClassBodyDeclarationWithComments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldType -> Flow Graph (Maybe FilePath)
commentsFromFieldType FieldType
field
boundTypeVariables :: Type -> [Name]
boundTypeVariables :: Type -> [Name]
boundTypeVariables Type
typ = case Type
typ of
TypeAnnotated (AnnotatedType Type
typ1 Map Name Term
_) -> Type -> [Name]
boundTypeVariables Type
typ1
TypeLambda (LambdaType Name
v Type
body) -> Name
vName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:(Type -> [Name]
boundTypeVariables Type
body)
Type
_ -> []
classModsPublic :: [Java.ClassModifier]
classModsPublic :: [ClassModifier]
classModsPublic = [ClassModifier
Java.ClassModifierPublic]
classifyDataReference :: Name -> Flow Graph JavaSymbolClass
classifyDataReference :: Name -> Flow Graph JavaSymbolClass
classifyDataReference Name
name = do
Maybe Element
mel <- Name -> Flow Graph (Maybe Element)
dereferenceElement Name
name
case Maybe Element
mel of
Maybe Element
Nothing -> JavaSymbolClass -> Flow Graph JavaSymbolClass
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return JavaSymbolClass
JavaSymbolLocalVariable
Just Element
el -> do
Type
typ <- Element -> Flow Graph Type
requireElementType Element
el
JavaSymbolClass -> Flow Graph JavaSymbolClass
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (JavaSymbolClass -> Flow Graph JavaSymbolClass)
-> JavaSymbolClass -> Flow Graph JavaSymbolClass
forall a b. (a -> b) -> a -> b
$ Type -> Term -> JavaSymbolClass
classifyDataTerm Type
typ (Term -> JavaSymbolClass) -> Term -> JavaSymbolClass
forall a b. (a -> b) -> a -> b
$ Element -> Term
elementData Element
el
classifyDataTerm :: Type -> Term -> JavaSymbolClass
classifyDataTerm :: Type -> Term -> JavaSymbolClass
classifyDataTerm Type
typ Term
term = if Term -> Bool
isLambda Term
term
then JavaSymbolClass
JavaSymbolClassUnaryFunction
else if Bool
hasTypeParameters Bool -> Bool -> Bool
|| Bool
isUnsupportedVariant
then JavaSymbolClass
JavaSymbolClassNullaryFunction
else JavaSymbolClass
JavaSymbolClassConstant
where
hasTypeParameters :: Bool
hasTypeParameters = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set Name -> Bool
forall a. Set a -> Bool
S.null (Set Name -> Bool) -> Set Name -> Bool
forall a b. (a -> b) -> a -> b
$ Type -> Set Name
freeVariablesInType Type
typ
isUnsupportedVariant :: Bool
isUnsupportedVariant = case Term -> Term
fullyStripTerm Term
term of
TermLet Let
_ -> Bool
True
Term
_ -> Bool
False
commentsFromElement :: Element -> Flow Graph (Maybe String)
= Term -> Flow Graph (Maybe FilePath)
getTermDescription (Term -> Flow Graph (Maybe FilePath))
-> (Element -> Term) -> Element -> Flow Graph (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Term
elementData
commentsFromFieldType :: FieldType -> Flow Graph (Maybe String)
= Type -> Flow Graph (Maybe FilePath)
getTypeDescription (Type -> Flow Graph (Maybe FilePath))
-> (FieldType -> Type) -> FieldType -> Flow Graph (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Type
fieldTypeType
constantDecl :: String -> Aliases -> Name -> Flow Graph Java.ClassBodyDeclarationWithComments
constantDecl :: FilePath
-> Aliases -> Name -> Flow Graph ClassBodyDeclarationWithComments
constantDecl FilePath
javaName Aliases
aliases Name
name = do
Type
jt <- Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
TypeVariable Name
_Name
Expression
arg <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases (Term -> Flow Graph Expression) -> Term -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ FilePath -> Term
Terms.string (FilePath -> Term) -> FilePath -> Term
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
unName Name
name
let init :: VariableInitializer
init = Expression -> VariableInitializer
Java.VariableInitializerExpression (Expression -> VariableInitializer)
-> Expression -> VariableInitializer
forall a b. (a -> b) -> a -> b
$ ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName Identifier
nameName Maybe TypeArgumentsOrDiamond
forall a. Maybe a
Nothing) [Expression
arg] Maybe ClassBody
forall a. Maybe a
Nothing
let var :: VariableDeclarator
var = Identifier -> Maybe VariableInitializer -> VariableDeclarator
javaVariableDeclarator (FilePath -> Identifier
Java.Identifier FilePath
javaName) (VariableInitializer -> Maybe VariableInitializer
forall a. a -> Maybe a
Just VariableInitializer
init)
ClassBodyDeclarationWithComments
-> Flow Graph ClassBodyDeclarationWithComments
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassBodyDeclarationWithComments
-> Flow Graph ClassBodyDeclarationWithComments)
-> ClassBodyDeclarationWithComments
-> Flow Graph ClassBodyDeclarationWithComments
forall a b. (a -> b) -> a -> b
$ ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment (ClassBodyDeclaration -> ClassBodyDeclarationWithComments)
-> ClassBodyDeclaration -> ClassBodyDeclarationWithComments
forall a b. (a -> b) -> a -> b
$ [FieldModifier]
-> Type -> VariableDeclarator -> ClassBodyDeclaration
javaMemberField [FieldModifier]
mods Type
jt VariableDeclarator
var
where
mods :: [FieldModifier]
mods = [FieldModifier
Java.FieldModifierPublic, FieldModifier
Java.FieldModifierStatic, FieldModifier
Java.FieldModifierFinal]
nameName :: Identifier
nameName = Aliases -> Name -> Identifier
nameToJavaName Aliases
aliases Name
_Name
constantDeclForFieldType :: Aliases -> FieldType -> Flow Graph Java.ClassBodyDeclarationWithComments
constantDeclForFieldType :: Aliases -> FieldType -> Flow Graph ClassBodyDeclarationWithComments
constantDeclForFieldType Aliases
aliases FieldType
ftyp = FilePath
-> Aliases -> Name -> Flow Graph ClassBodyDeclarationWithComments
constantDecl FilePath
javaName Aliases
aliases Name
name
where
name :: Name
name = FieldType -> Name
fieldTypeName FieldType
ftyp
javaName :: FilePath
javaName = FilePath
"FIELD_NAME_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
nonAlnumToUnderscores (CaseConvention -> CaseConvention -> FilePath -> FilePath
convertCase CaseConvention
CaseConventionCamel CaseConvention
CaseConventionUpperSnake (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
unName Name
name)
constantDeclForTypeName :: Aliases -> Name -> Flow Graph Java.ClassBodyDeclarationWithComments
constantDeclForTypeName :: Aliases -> Name -> Flow Graph ClassBodyDeclarationWithComments
constantDeclForTypeName = FilePath
-> Aliases -> Name -> Flow Graph ClassBodyDeclarationWithComments
constantDecl FilePath
"TYPE_NAME"
constructElementsInterface :: Module -> [Java.InterfaceMemberDeclaration] -> (Name, Java.CompilationUnit)
constructElementsInterface :: Module -> [InterfaceMemberDeclaration] -> (Name, CompilationUnit)
constructElementsInterface Module
mod [InterfaceMemberDeclaration]
members = (Name
elName, CompilationUnit
cu)
where
cu :: CompilationUnit
cu = OrdinaryCompilationUnit -> CompilationUnit
Java.CompilationUnitOrdinary (OrdinaryCompilationUnit -> CompilationUnit)
-> OrdinaryCompilationUnit -> CompilationUnit
forall a b. (a -> b) -> a -> b
$ Maybe PackageDeclaration
-> [ImportDeclaration]
-> [TypeDeclarationWithComments]
-> OrdinaryCompilationUnit
Java.OrdinaryCompilationUnit (PackageDeclaration -> Maybe PackageDeclaration
forall a. a -> Maybe a
Just PackageDeclaration
pkg) [] [TypeDeclarationWithComments
decl]
pkg :: PackageDeclaration
pkg = Namespace -> PackageDeclaration
javaPackageDeclaration (Namespace -> PackageDeclaration)
-> Namespace -> PackageDeclaration
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
mod
mods :: [InterfaceModifier]
mods = [InterfaceModifier
Java.InterfaceModifierPublic]
className :: FilePath
className = Namespace -> FilePath
elementsClassName (Namespace -> FilePath) -> Namespace -> FilePath
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
mod
elName :: Name
elName = QualifiedName -> Name
unqualifyName (QualifiedName -> Name) -> QualifiedName -> Name
forall a b. (a -> b) -> a -> b
$ Maybe Namespace -> FilePath -> QualifiedName
QualifiedName (Namespace -> Maybe Namespace
forall a. a -> Maybe a
Just (Namespace -> Maybe Namespace) -> Namespace -> Maybe Namespace
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
mod) FilePath
className
body :: InterfaceBody
body = [InterfaceMemberDeclaration] -> InterfaceBody
Java.InterfaceBody [InterfaceMemberDeclaration]
members
itf :: TypeDeclaration
itf = InterfaceDeclaration -> TypeDeclaration
Java.TypeDeclarationInterface (InterfaceDeclaration -> TypeDeclaration)
-> InterfaceDeclaration -> TypeDeclaration
forall a b. (a -> b) -> a -> b
$ NormalInterfaceDeclaration -> InterfaceDeclaration
Java.InterfaceDeclarationNormalInterface (NormalInterfaceDeclaration -> InterfaceDeclaration)
-> NormalInterfaceDeclaration -> InterfaceDeclaration
forall a b. (a -> b) -> a -> b
$
[InterfaceModifier]
-> TypeIdentifier
-> [TypeParameter]
-> [InterfaceType]
-> InterfaceBody
-> NormalInterfaceDeclaration
Java.NormalInterfaceDeclaration [InterfaceModifier]
mods (FilePath -> TypeIdentifier
javaTypeIdentifier FilePath
className) [] [] InterfaceBody
body
decl :: TypeDeclarationWithComments
decl = TypeDeclaration -> Maybe FilePath -> TypeDeclarationWithComments
Java.TypeDeclarationWithComments TypeDeclaration
itf (Maybe FilePath -> TypeDeclarationWithComments)
-> Maybe FilePath -> TypeDeclarationWithComments
forall a b. (a -> b) -> a -> b
$ Module -> Maybe FilePath
moduleDescription Module
mod
constructModule :: Module
-> M.Map Type (Coder Graph Graph (Term) Java.Expression)
-> [(Element, TypedTerm)]
-> Flow Graph (M.Map Name Java.CompilationUnit)
constructModule :: Module
-> Map Type (Coder Graph Graph Term Expression)
-> [(Element, TypedTerm)]
-> Flow Graph (Map Name CompilationUnit)
constructModule Module
mod Map Type (Coder Graph Graph Term Expression)
coders [(Element, TypedTerm)]
pairs = do
let isTypePair :: (a, TypedTerm) -> Bool
isTypePair = Type -> Bool
isType (Type -> Bool)
-> ((a, TypedTerm) -> Type) -> (a, TypedTerm) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypedTerm -> Type
typedTermType (TypedTerm -> Type)
-> ((a, TypedTerm) -> TypedTerm) -> (a, TypedTerm) -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, TypedTerm) -> TypedTerm
forall a b. (a, b) -> b
snd
let typePairs :: [(Element, TypedTerm)]
typePairs = ((Element, TypedTerm) -> Bool)
-> [(Element, TypedTerm)] -> [(Element, TypedTerm)]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Element, TypedTerm) -> Bool
forall {a}. (a, TypedTerm) -> Bool
isTypePair [(Element, TypedTerm)]
pairs
let dataPairs :: [(Element, TypedTerm)]
dataPairs = ((Element, TypedTerm) -> Bool)
-> [(Element, TypedTerm)] -> [(Element, TypedTerm)]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not (Bool -> Bool)
-> ((Element, TypedTerm) -> Bool) -> (Element, TypedTerm) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element, TypedTerm) -> Bool
forall {a}. (a, TypedTerm) -> Bool
isTypePair) [(Element, TypedTerm)]
pairs
[(Name, CompilationUnit)]
typeUnits <- ((Element, TypedTerm) -> Flow Graph (Name, CompilationUnit))
-> [(Element, TypedTerm)] -> Flow Graph [(Name, CompilationUnit)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Element, TypedTerm) -> Flow Graph (Name, CompilationUnit)
typeToClass [(Element, TypedTerm)]
typePairs
[InterfaceMemberDeclaration]
dataMembers <- ((Element, TypedTerm) -> Flow Graph InterfaceMemberDeclaration)
-> [(Element, TypedTerm)]
-> Flow Graph [InterfaceMemberDeclaration]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Map Type (Coder Graph Graph Term Expression)
-> (Element, TypedTerm) -> Flow Graph InterfaceMemberDeclaration
forall {s2}.
Map Type (Coder Graph s2 Term Expression)
-> (Element, TypedTerm) -> Flow Graph InterfaceMemberDeclaration
termToInterfaceMember Map Type (Coder Graph Graph Term Expression)
coders) [(Element, TypedTerm)]
dataPairs
Map Name CompilationUnit -> Flow Graph (Map Name CompilationUnit)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Name CompilationUnit -> Flow Graph (Map Name CompilationUnit))
-> Map Name CompilationUnit
-> Flow Graph (Map Name CompilationUnit)
forall a b. (a -> b) -> a -> b
$ [(Name, CompilationUnit)] -> Map Name CompilationUnit
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, CompilationUnit)] -> Map Name CompilationUnit)
-> [(Name, CompilationUnit)] -> Map Name CompilationUnit
forall a b. (a -> b) -> a -> b
$ [(Name, CompilationUnit)]
typeUnits [(Name, CompilationUnit)]
-> [(Name, CompilationUnit)] -> [(Name, CompilationUnit)]
forall a. [a] -> [a] -> [a]
++ ([Module -> [InterfaceMemberDeclaration] -> (Name, CompilationUnit)
constructElementsInterface Module
mod [InterfaceMemberDeclaration]
dataMembers | Bool -> Bool
not ([InterfaceMemberDeclaration] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [InterfaceMemberDeclaration]
dataMembers)])
where
pkg :: PackageDeclaration
pkg = Namespace -> PackageDeclaration
javaPackageDeclaration (Namespace -> PackageDeclaration)
-> Namespace -> PackageDeclaration
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
mod
aliases :: Aliases
aliases = Module -> Aliases
importAliasesForModule Module
mod
typeToClass :: (Element, TypedTerm) -> Flow Graph (Name, CompilationUnit)
typeToClass pair :: (Element, TypedTerm)
pair@(Element
el, TypedTerm
_) = do
Bool
isSer <- Element -> Flow Graph Bool
isSerializable Element
el
let imports :: [ImportDeclaration]
imports = if Bool
isSer
then [SingleTypeImportDeclaration -> ImportDeclaration
Java.ImportDeclarationSingleType (SingleTypeImportDeclaration -> ImportDeclaration)
-> SingleTypeImportDeclaration -> ImportDeclaration
forall a b. (a -> b) -> a -> b
$ TypeName -> SingleTypeImportDeclaration
Java.SingleTypeImportDeclaration (TypeName -> SingleTypeImportDeclaration)
-> TypeName -> SingleTypeImportDeclaration
forall a b. (a -> b) -> a -> b
$ Identifier -> TypeName
javaTypeName (Identifier -> TypeName) -> Identifier -> TypeName
forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.Identifier FilePath
"java.io.Serializable"]
else []
TypeDeclarationWithComments
decl <- Bool
-> Aliases
-> (Element, TypedTerm)
-> Flow Graph TypeDeclarationWithComments
declarationForType Bool
isSer Aliases
aliases (Element, TypedTerm)
pair
(Name, CompilationUnit) -> Flow Graph (Name, CompilationUnit)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> Name
elementName Element
el,
OrdinaryCompilationUnit -> CompilationUnit
Java.CompilationUnitOrdinary (OrdinaryCompilationUnit -> CompilationUnit)
-> OrdinaryCompilationUnit -> CompilationUnit
forall a b. (a -> b) -> a -> b
$ Maybe PackageDeclaration
-> [ImportDeclaration]
-> [TypeDeclarationWithComments]
-> OrdinaryCompilationUnit
Java.OrdinaryCompilationUnit (PackageDeclaration -> Maybe PackageDeclaration
forall a. a -> Maybe a
Just PackageDeclaration
pkg) [ImportDeclaration]
imports [TypeDeclarationWithComments
decl])
termToInterfaceMember :: Map Type (Coder Graph s2 Term Expression)
-> (Element, TypedTerm) -> Flow Graph InterfaceMemberDeclaration
termToInterfaceMember Map Type (Coder Graph s2 Term Expression)
coders (Element, TypedTerm)
pair = FilePath
-> Flow Graph InterfaceMemberDeclaration
-> Flow Graph InterfaceMemberDeclaration
forall s a. FilePath -> Flow s a -> Flow s a
withTrace (FilePath
"element " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
unName (Element -> Name
elementName Element
el)) (Flow Graph InterfaceMemberDeclaration
-> Flow Graph InterfaceMemberDeclaration)
-> Flow Graph InterfaceMemberDeclaration
-> Flow Graph InterfaceMemberDeclaration
forall a b. (a -> b) -> a -> b
$ do
let expanded :: Term
expanded = Term -> Term
contractTerm (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ Term -> Term
unshadowVariables (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ Term -> Term
expandTypedLambdas (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ TypedTerm -> Term
typedTermTerm (TypedTerm -> Term) -> TypedTerm -> Term
forall a b. (a -> b) -> a -> b
$ (Element, TypedTerm) -> TypedTerm
forall a b. (a, b) -> b
snd (Element, TypedTerm)
pair
case Type -> Term -> JavaSymbolClass
classifyDataTerm Type
typ Term
expanded of
JavaSymbolClass
JavaSymbolClassConstant -> Map Type (Coder Graph s2 Term Expression)
-> Element -> Term -> Flow Graph InterfaceMemberDeclaration
forall {s2} {v1}.
Map Type (Coder Graph s2 v1 Expression)
-> Element -> v1 -> Flow Graph InterfaceMemberDeclaration
termToConstant Map Type (Coder Graph s2 Term Expression)
coders Element
el Term
expanded
JavaSymbolClass
JavaSymbolClassNullaryFunction -> Map Type (Coder Graph s2 Term Expression)
-> Element -> Term -> Flow Graph InterfaceMemberDeclaration
forall {p} {p}.
p -> p -> Term -> Flow Graph InterfaceMemberDeclaration
termToNullaryMethod Map Type (Coder Graph s2 Term Expression)
coders Element
el Term
expanded
JavaSymbolClass
JavaSymbolClassUnaryFunction -> Map Type (Coder Graph s2 Term Expression)
-> Element -> Term -> Flow Graph InterfaceMemberDeclaration
forall {p} {p}.
p -> p -> Term -> Flow Graph InterfaceMemberDeclaration
termToUnaryMethod Map Type (Coder Graph s2 Term Expression)
coders Element
el Term
expanded
where
el :: Element
el = (Element, TypedTerm) -> Element
forall a b. (a, b) -> a
fst (Element, TypedTerm)
pair
typ :: Type
typ = TypedTerm -> Type
typedTermType (TypedTerm -> Type) -> TypedTerm -> Type
forall a b. (a -> b) -> a -> b
$ (Element, TypedTerm) -> TypedTerm
forall a b. (a, b) -> b
snd (Element, TypedTerm)
pair
tparams :: [TypeParameter]
tparams = Type -> [TypeParameter]
javaTypeParametersForType Type
typ
mname :: FilePath
mname = FilePath -> FilePath
sanitizeJavaName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
decapitalize (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
localNameOfEager (Name -> FilePath) -> Name -> FilePath
forall a b. (a -> b) -> a -> b
$ Element -> Name
elementName Element
el
termToConstant :: Map Type (Coder Graph s2 v1 Expression)
-> Element -> v1 -> Flow Graph InterfaceMemberDeclaration
termToConstant Map Type (Coder Graph s2 v1 Expression)
coders Element
el v1
term = do
UnannType
jtype <- Type -> UnannType
Java.UnannType (Type -> UnannType) -> Flow Graph Type -> Flow Graph UnannType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases Type
typ
Expression
jterm <- Coder Graph s2 v1 Expression -> v1 -> Flow Graph Expression
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (Maybe (Coder Graph s2 v1 Expression)
-> Coder Graph s2 v1 Expression
forall a. HasCallStack => Maybe a -> a
Y.fromJust (Maybe (Coder Graph s2 v1 Expression)
-> Coder Graph s2 v1 Expression)
-> Maybe (Coder Graph s2 v1 Expression)
-> Coder Graph s2 v1 Expression
forall a b. (a -> b) -> a -> b
$ Type
-> Map Type (Coder Graph s2 v1 Expression)
-> Maybe (Coder Graph s2 v1 Expression)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Type
typ Map Type (Coder Graph s2 v1 Expression)
coders) v1
term
let mods :: [a]
mods = []
let var :: VariableDeclarator
var = Identifier -> Maybe VariableInitializer -> VariableDeclarator
javaVariableDeclarator (Name -> Identifier
javaVariableName (Name -> Identifier) -> Name -> Identifier
forall a b. (a -> b) -> a -> b
$ Element -> Name
elementName Element
el) (Maybe VariableInitializer -> VariableDeclarator)
-> Maybe VariableInitializer -> VariableDeclarator
forall a b. (a -> b) -> a -> b
$ VariableInitializer -> Maybe VariableInitializer
forall a. a -> Maybe a
Just (VariableInitializer -> Maybe VariableInitializer)
-> VariableInitializer -> Maybe VariableInitializer
forall a b. (a -> b) -> a -> b
$ Expression -> VariableInitializer
Java.VariableInitializerExpression Expression
jterm
InterfaceMemberDeclaration -> Flow Graph InterfaceMemberDeclaration
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceMemberDeclaration
-> Flow Graph InterfaceMemberDeclaration)
-> InterfaceMemberDeclaration
-> Flow Graph InterfaceMemberDeclaration
forall a b. (a -> b) -> a -> b
$ ConstantDeclaration -> InterfaceMemberDeclaration
Java.InterfaceMemberDeclarationConstant (ConstantDeclaration -> InterfaceMemberDeclaration)
-> ConstantDeclaration -> InterfaceMemberDeclaration
forall a b. (a -> b) -> a -> b
$ [ConstantModifier]
-> UnannType -> [VariableDeclarator] -> ConstantDeclaration
Java.ConstantDeclaration [ConstantModifier]
forall a. [a]
mods UnannType
jtype [VariableDeclarator
var]
termToNullaryMethod :: p -> p -> Term -> Flow Graph InterfaceMemberDeclaration
termToNullaryMethod p
coders p
el Term
term0 = Aliases
-> Term
-> (Aliases
-> Term
-> [BlockStatement]
-> Flow Graph InterfaceMemberDeclaration)
-> Flow Graph InterfaceMemberDeclaration
forall x.
Aliases
-> Term
-> (Aliases -> Term -> [BlockStatement] -> Flow Graph x)
-> Flow Graph x
maybeLet Aliases
aliases Term
term0 Aliases
-> Term
-> [BlockStatement]
-> Flow Graph InterfaceMemberDeclaration
forInnerTerm
where
forInnerTerm :: Aliases
-> Term
-> [BlockStatement]
-> Flow Graph InterfaceMemberDeclaration
forInnerTerm Aliases
aliases2 Term
term [BlockStatement]
stmts = do
Result
result <- Type -> Result
javaTypeToJavaResult (Type -> Result) -> Flow Graph Type -> Flow Graph Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases2 Type
typ
Expression
jbody <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases2 Term
term
let mods :: [InterfaceMethodModifier]
mods = [InterfaceMethodModifier
Java.InterfaceMethodModifierStatic]
let returnSt :: BlockStatement
returnSt = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement (Maybe Expression -> Statement) -> Maybe Expression -> Statement
forall a b. (a -> b) -> a -> b
$ Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
jbody
InterfaceMemberDeclaration -> Flow Graph InterfaceMemberDeclaration
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceMemberDeclaration
-> Flow Graph InterfaceMemberDeclaration)
-> InterfaceMemberDeclaration
-> Flow Graph InterfaceMemberDeclaration
forall a b. (a -> b) -> a -> b
$ [InterfaceMethodModifier]
-> [TypeParameter]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> InterfaceMemberDeclaration
interfaceMethodDeclaration [InterfaceMethodModifier]
mods [TypeParameter]
tparams FilePath
mname [] Result
result ([BlockStatement] -> Maybe [BlockStatement]
forall a. a -> Maybe a
Just ([BlockStatement] -> Maybe [BlockStatement])
-> [BlockStatement] -> Maybe [BlockStatement]
forall a b. (a -> b) -> a -> b
$ [BlockStatement]
stmts [BlockStatement] -> [BlockStatement] -> [BlockStatement]
forall a. [a] -> [a] -> [a]
++ [BlockStatement
returnSt])
termToUnaryMethod :: p -> p -> Term -> Flow Graph InterfaceMemberDeclaration
termToUnaryMethod p
coders p
el Term
term = case Type -> Type
stripType Type
typ of
TypeFunction (FunctionType Type
dom Type
cod) -> Aliases
-> Term
-> (Aliases
-> Term
-> [BlockStatement]
-> Flow Graph InterfaceMemberDeclaration)
-> Flow Graph InterfaceMemberDeclaration
forall x.
Aliases
-> Term
-> (Aliases -> Term -> [BlockStatement] -> Flow Graph x)
-> Flow Graph x
maybeLet Aliases
aliases Term
term ((Aliases
-> Term
-> [BlockStatement]
-> Flow Graph InterfaceMemberDeclaration)
-> Flow Graph InterfaceMemberDeclaration)
-> (Aliases
-> Term
-> [BlockStatement]
-> Flow Graph InterfaceMemberDeclaration)
-> Flow Graph InterfaceMemberDeclaration
forall a b. (a -> b) -> a -> b
$ \Aliases
aliases2 Term
term2 [BlockStatement]
stmts2 -> case Term -> Term
fullyStripTerm Term
term2 of
TermFunction (FunctionLambda (Lambda Name
v Maybe Type
_ Term
body)) -> do
Type
jdom <- Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases2 Type
dom
Type
jcod <- Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases2 Type
cod
let mods :: [InterfaceMethodModifier]
mods = [InterfaceMethodModifier
Java.InterfaceMethodModifierStatic]
let param :: FormalParameter
param = Type -> Name -> FormalParameter
javaTypeToJavaFormalParameter Type
jdom (FilePath -> Name
Name (FilePath -> Name) -> FilePath -> Name
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
unName Name
v)
let result :: Result
result = Type -> Result
javaTypeToJavaResult Type
jcod
Aliases
-> Term
-> (Aliases
-> Term
-> [BlockStatement]
-> Flow Graph InterfaceMemberDeclaration)
-> Flow Graph InterfaceMemberDeclaration
forall x.
Aliases
-> Term
-> (Aliases -> Term -> [BlockStatement] -> Flow Graph x)
-> Flow Graph x
maybeLet Aliases
aliases2 Term
body ((Aliases
-> Term
-> [BlockStatement]
-> Flow Graph InterfaceMemberDeclaration)
-> Flow Graph InterfaceMemberDeclaration)
-> (Aliases
-> Term
-> [BlockStatement]
-> Flow Graph InterfaceMemberDeclaration)
-> Flow Graph InterfaceMemberDeclaration
forall a b. (a -> b) -> a -> b
$ \Aliases
aliases3 Term
term3 [BlockStatement]
stmts3 -> do
Expression
jbody <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases3 Term
term3
let returnSt :: BlockStatement
returnSt = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement (Maybe Expression -> Statement) -> Maybe Expression -> Statement
forall a b. (a -> b) -> a -> b
$ Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
jbody
InterfaceMemberDeclaration -> Flow Graph InterfaceMemberDeclaration
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceMemberDeclaration
-> Flow Graph InterfaceMemberDeclaration)
-> InterfaceMemberDeclaration
-> Flow Graph InterfaceMemberDeclaration
forall a b. (a -> b) -> a -> b
$ [InterfaceMethodModifier]
-> [TypeParameter]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> InterfaceMemberDeclaration
interfaceMethodDeclaration [InterfaceMethodModifier]
mods [TypeParameter]
tparams FilePath
mname [FormalParameter
param] Result
result ([BlockStatement] -> Maybe [BlockStatement]
forall a. a -> Maybe a
Just ([BlockStatement] -> Maybe [BlockStatement])
-> [BlockStatement] -> Maybe [BlockStatement]
forall a b. (a -> b) -> a -> b
$ [BlockStatement]
stmts2 [BlockStatement] -> [BlockStatement] -> [BlockStatement]
forall a. [a] -> [a] -> [a]
++ [BlockStatement]
stmts3 [BlockStatement] -> [BlockStatement] -> [BlockStatement]
forall a. [a] -> [a] -> [a]
++ [BlockStatement
returnSt])
Term
_ -> FilePath -> FilePath -> Flow Graph InterfaceMemberDeclaration
forall s x. FilePath -> FilePath -> Flow s x
unexpected FilePath
"function term" (FilePath -> Flow Graph InterfaceMemberDeclaration)
-> FilePath -> Flow Graph InterfaceMemberDeclaration
forall a b. (a -> b) -> a -> b
$ Term -> FilePath
forall a. Show a => a -> FilePath
show Term
term
Type
_ -> FilePath -> FilePath -> Flow Graph InterfaceMemberDeclaration
forall s x. FilePath -> FilePath -> Flow s x
unexpected FilePath
"function type" (FilePath -> Flow Graph InterfaceMemberDeclaration)
-> FilePath -> Flow Graph InterfaceMemberDeclaration
forall a b. (a -> b) -> a -> b
$ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
typ
declarationForLambdaType :: Bool -> Aliases
-> [Java.TypeParameter] -> Name -> LambdaType -> Flow Graph Java.ClassDeclaration
declarationForLambdaType :: Bool
-> Aliases
-> [TypeParameter]
-> Name
-> LambdaType
-> Flow Graph ClassDeclaration
declarationForLambdaType Bool
isSer Aliases
aliases [TypeParameter]
tparams Name
elName (LambdaType (Name FilePath
v) Type
body) =
Bool
-> Bool
-> Aliases
-> [TypeParameter]
-> Name
-> Type
-> Flow Graph ClassDeclaration
toClassDecl Bool
False Bool
isSer Aliases
aliases ([TypeParameter]
tparams [TypeParameter] -> [TypeParameter] -> [TypeParameter]
forall a. [a] -> [a] -> [a]
++ [TypeParameter
param]) Name
elName Type
body
where
param :: TypeParameter
param = FilePath -> TypeParameter
javaTypeParameter (FilePath -> TypeParameter) -> FilePath -> TypeParameter
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
capitalize FilePath
v
declarationForRecordType :: Bool -> Bool -> Aliases -> [Java.TypeParameter] -> Name
-> [FieldType] -> Flow Graph Java.ClassDeclaration
declarationForRecordType :: Bool
-> Bool
-> Aliases
-> [TypeParameter]
-> Name
-> [FieldType]
-> Flow Graph ClassDeclaration
declarationForRecordType Bool
isInner Bool
isSer Aliases
aliases [TypeParameter]
tparams Name
elName [FieldType]
fields = do
[ClassBodyDeclaration]
memberVars <- (FieldType -> Flow Graph ClassBodyDeclaration)
-> [FieldType] -> Flow Graph [ClassBodyDeclaration]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM FieldType -> Flow Graph ClassBodyDeclaration
toMemberVar [FieldType]
fields
[ClassBodyDeclarationWithComments]
memberVars' <- (ClassBodyDeclaration
-> FieldType -> Flow Graph ClassBodyDeclarationWithComments)
-> [ClassBodyDeclaration]
-> [FieldType]
-> Flow Graph [ClassBodyDeclarationWithComments]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
CM.zipWithM ClassBodyDeclaration
-> FieldType -> Flow Graph ClassBodyDeclarationWithComments
addComment [ClassBodyDeclaration]
memberVars [FieldType]
fields
[ClassBodyDeclaration]
withMethods <- if [FieldType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [FieldType]
fields Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
then (FieldType -> Flow Graph ClassBodyDeclaration)
-> [FieldType] -> Flow Graph [ClassBodyDeclaration]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM FieldType -> Flow Graph ClassBodyDeclaration
toWithMethod [FieldType]
fields
else [ClassBodyDeclaration] -> Flow Graph [ClassBodyDeclaration]
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
ClassBodyDeclaration
cons <- Flow Graph ClassBodyDeclaration
constructor
[ClassBodyDeclarationWithComments]
tn <- if Bool
isInner then [ClassBodyDeclarationWithComments]
-> Flow Graph [ClassBodyDeclarationWithComments]
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else do
ClassBodyDeclarationWithComments
d <- Aliases -> Name -> Flow Graph ClassBodyDeclarationWithComments
constantDeclForTypeName Aliases
aliases Name
elName
[ClassBodyDeclarationWithComments]
dfields <- (FieldType -> Flow Graph ClassBodyDeclarationWithComments)
-> [FieldType] -> Flow Graph [ClassBodyDeclarationWithComments]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Aliases -> FieldType -> Flow Graph ClassBodyDeclarationWithComments
constantDeclForFieldType Aliases
aliases) [FieldType]
fields
[ClassBodyDeclarationWithComments]
-> Flow Graph [ClassBodyDeclarationWithComments]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassBodyDeclarationWithComments
dClassBodyDeclarationWithComments
-> [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
forall a. a -> [a] -> [a]
:[ClassBodyDeclarationWithComments]
dfields)
let bodyDecls :: [ClassBodyDeclarationWithComments]
bodyDecls = [ClassBodyDeclarationWithComments]
tn [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
forall a. [a] -> [a] -> [a]
++ [ClassBodyDeclarationWithComments]
memberVars' [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
forall a. [a] -> [a] -> [a]
++ (ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment (ClassBodyDeclaration -> ClassBodyDeclarationWithComments)
-> [ClassBodyDeclaration] -> [ClassBodyDeclarationWithComments]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClassBodyDeclaration
cons, ClassBodyDeclaration
equalsMethod, ClassBodyDeclaration
hashCodeMethod] [ClassBodyDeclaration]
-> [ClassBodyDeclaration] -> [ClassBodyDeclaration]
forall a. [a] -> [a] -> [a]
++ [ClassBodyDeclaration]
withMethods)
ClassDeclaration -> Flow Graph ClassDeclaration
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassDeclaration -> Flow Graph ClassDeclaration)
-> ClassDeclaration -> Flow Graph ClassDeclaration
forall a b. (a -> b) -> a -> b
$ Aliases
-> [TypeParameter]
-> Name
-> [ClassModifier]
-> Maybe Name
-> [InterfaceType]
-> [ClassBodyDeclarationWithComments]
-> ClassDeclaration
javaClassDeclaration Aliases
aliases [TypeParameter]
tparams Name
elName [ClassModifier]
classModsPublic Maybe Name
forall a. Maybe a
Nothing (Bool -> [InterfaceType]
interfaceTypes Bool
isSer) [ClassBodyDeclarationWithComments]
bodyDecls
where
constructor :: Flow Graph ClassBodyDeclaration
constructor = do
[FormalParameter]
params <- (FieldType -> Flow Graph FormalParameter)
-> [FieldType] -> Flow Graph [FormalParameter]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Aliases -> FieldType -> Flow Graph FormalParameter
fieldTypeToFormalParam Aliases
aliases) [FieldType]
fields
let nullCheckStmts :: [BlockStatement]
nullCheckStmts = FieldType -> BlockStatement
fieldToNullCheckStatement (FieldType -> BlockStatement) -> [FieldType] -> [BlockStatement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType]
fields
let assignStmts :: [BlockStatement]
assignStmts = FieldType -> BlockStatement
fieldToAssignStatement (FieldType -> BlockStatement) -> [FieldType] -> [BlockStatement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType]
fields
ClassBodyDeclaration -> Flow Graph ClassBodyDeclaration
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassBodyDeclaration -> Flow Graph ClassBodyDeclaration)
-> ClassBodyDeclaration -> Flow Graph ClassBodyDeclaration
forall a b. (a -> b) -> a -> b
$ Aliases
-> Name
-> Bool
-> [FormalParameter]
-> [BlockStatement]
-> ClassBodyDeclaration
makeConstructor Aliases
aliases Name
elName Bool
False [FormalParameter]
params ([BlockStatement] -> ClassBodyDeclaration)
-> [BlockStatement] -> ClassBodyDeclaration
forall a b. (a -> b) -> a -> b
$ [BlockStatement]
nullCheckStmts [BlockStatement] -> [BlockStatement] -> [BlockStatement]
forall a. [a] -> [a] -> [a]
++ [BlockStatement]
assignStmts
fieldToAssignStatement :: FieldType -> BlockStatement
fieldToAssignStatement = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement)
-> (FieldType -> Statement) -> FieldType -> BlockStatement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Statement
toAssignStmt (Name -> Statement)
-> (FieldType -> Name) -> FieldType -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Name
fieldTypeName
fieldArgs :: [Expression]
fieldArgs = Name -> Expression
fieldNameToJavaExpression (Name -> Expression)
-> (FieldType -> Name) -> FieldType -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Name
fieldTypeName (FieldType -> Expression) -> [FieldType] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType]
fields
toMemberVar :: FieldType -> Flow Graph ClassBodyDeclaration
toMemberVar (FieldType Name
fname Type
ft) = do
let mods :: [FieldModifier]
mods = [FieldModifier
Java.FieldModifierPublic, FieldModifier
Java.FieldModifierFinal]
Type
jt <- Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases Type
ft
let var :: VariableDeclarator
var = Name -> VariableDeclarator
fieldNameToJavaVariableDeclarator Name
fname
ClassBodyDeclaration -> Flow Graph ClassBodyDeclaration
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassBodyDeclaration -> Flow Graph ClassBodyDeclaration)
-> ClassBodyDeclaration -> Flow Graph ClassBodyDeclaration
forall a b. (a -> b) -> a -> b
$ [FieldModifier]
-> Type -> VariableDeclarator -> ClassBodyDeclaration
javaMemberField [FieldModifier]
mods Type
jt VariableDeclarator
var
toWithMethod :: FieldType -> Flow Graph ClassBodyDeclaration
toWithMethod FieldType
field = do
FormalParameter
param <- Aliases -> FieldType -> Flow Graph FormalParameter
fieldTypeToFormalParam Aliases
aliases FieldType
field
ClassBodyDeclaration -> Flow Graph ClassBodyDeclaration
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassBodyDeclaration -> Flow Graph ClassBodyDeclaration)
-> ClassBodyDeclaration -> Flow Graph ClassBodyDeclaration
forall a b. (a -> b) -> a -> b
$ [MethodModifier]
-> [TypeParameter]
-> [Annotation]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> ClassBodyDeclaration
methodDeclaration [MethodModifier]
mods [] [Annotation]
forall a. [a]
anns FilePath
methodName [FormalParameter
param] Result
result ([BlockStatement] -> Maybe [BlockStatement]
forall a. a -> Maybe a
Just [BlockStatement
nullCheck, BlockStatement
returnStmt])
where
anns :: [a]
anns = []
mods :: [MethodModifier]
mods = [MethodModifier
Java.MethodModifierPublic]
methodName :: FilePath
methodName = FilePath
"with" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
nonAlnumToUnderscores (FilePath -> FilePath
capitalize (Name -> FilePath
unName (Name -> FilePath) -> Name -> FilePath
forall a b. (a -> b) -> a -> b
$ FieldType -> Name
fieldTypeName FieldType
field))
nullCheck :: BlockStatement
nullCheck = FieldType -> BlockStatement
fieldToNullCheckStatement FieldType
field
result :: Result
result = ReferenceType -> Result
referenceTypeToResult (ReferenceType -> Result) -> ReferenceType -> Result
forall a b. (a -> b) -> a -> b
$ Aliases
-> Bool
-> [TypeArgument]
-> Name
-> Maybe FilePath
-> ReferenceType
nameToJavaReferenceType Aliases
aliases Bool
False [] Name
elName Maybe FilePath
forall a. Maybe a
Nothing
consId :: Identifier
consId = FilePath -> Identifier
Java.Identifier (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
sanitizeJavaName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
localNameOfEager Name
elName
returnStmt :: BlockStatement
returnStmt = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement (Maybe Expression -> Statement) -> Maybe Expression -> Statement
forall a b. (a -> b) -> a -> b
$ Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Expression -> Maybe Expression) -> Expression -> Maybe Expression
forall a b. (a -> b) -> a -> b
$
ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName Identifier
consId Maybe TypeArgumentsOrDiamond
forall a. Maybe a
Nothing) [Expression]
fieldArgs Maybe ClassBody
forall a. Maybe a
Nothing
equalsMethod :: ClassBodyDeclaration
equalsMethod = [MethodModifier]
-> [TypeParameter]
-> [Annotation]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> ClassBodyDeclaration
methodDeclaration [MethodModifier]
mods [] [Annotation]
anns FilePath
equalsMethodName [FormalParameter
param] Result
result (Maybe [BlockStatement] -> ClassBodyDeclaration)
-> Maybe [BlockStatement] -> ClassBodyDeclaration
forall a b. (a -> b) -> a -> b
$
[BlockStatement] -> Maybe [BlockStatement]
forall a. a -> Maybe a
Just [BlockStatement
instanceOfStmt,
BlockStatement
castStmt,
BlockStatement
returnAllFieldsEqual]
where
anns :: [Annotation]
anns = [Annotation
overrideAnnotation]
mods :: [MethodModifier]
mods = [MethodModifier
Java.MethodModifierPublic]
param :: FormalParameter
param = Type -> Name -> FormalParameter
javaTypeToJavaFormalParameter ([ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [] Maybe PackageName
forall a. Maybe a
Nothing FilePath
"Object") (FilePath -> Name
Name FilePath
otherInstanceName)
result :: Result
result = Type -> Result
javaTypeToJavaResult Type
javaBooleanType
tmpName :: FilePath
tmpName = FilePath
"o"
instanceOfStmt :: BlockStatement
instanceOfStmt = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ IfThenStatement -> Statement
Java.StatementIfThen (IfThenStatement -> Statement) -> IfThenStatement -> Statement
forall a b. (a -> b) -> a -> b
$
Expression -> Statement -> IfThenStatement
Java.IfThenStatement Expression
cond Statement
returnFalse
where
cond :: Expression
cond = UnaryExpression -> Expression
javaUnaryExpressionToJavaExpression (UnaryExpression -> Expression) -> UnaryExpression -> Expression
forall a b. (a -> b) -> a -> b
$
UnaryExpressionNotPlusMinus -> UnaryExpression
Java.UnaryExpressionOther (UnaryExpressionNotPlusMinus -> UnaryExpression)
-> UnaryExpressionNotPlusMinus -> UnaryExpression
forall a b. (a -> b) -> a -> b
$
UnaryExpression -> UnaryExpressionNotPlusMinus
Java.UnaryExpressionNotPlusMinusNot (UnaryExpression -> UnaryExpressionNotPlusMinus)
-> UnaryExpression -> UnaryExpressionNotPlusMinus
forall a b. (a -> b) -> a -> b
$
RelationalExpression -> UnaryExpression
javaRelationalExpressionToJavaUnaryExpression (RelationalExpression -> UnaryExpression)
-> RelationalExpression -> UnaryExpression
forall a b. (a -> b) -> a -> b
$
RelationalExpression -> ReferenceType -> RelationalExpression
javaInstanceOf RelationalExpression
other ReferenceType
parent
where
other :: RelationalExpression
other = Identifier -> RelationalExpression
javaIdentifierToJavaRelationalExpression (Identifier -> RelationalExpression)
-> Identifier -> RelationalExpression
forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
javaIdentifier FilePath
otherInstanceName
parent :: ReferenceType
parent = Aliases
-> Bool
-> [TypeArgument]
-> Name
-> Maybe FilePath
-> ReferenceType
nameToJavaReferenceType Aliases
aliases Bool
False [] Name
elName Maybe FilePath
forall a. Maybe a
Nothing
returnFalse :: Statement
returnFalse = Maybe Expression -> Statement
javaReturnStatement (Maybe Expression -> Statement) -> Maybe Expression -> Statement
forall a b. (a -> b) -> a -> b
$ Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Expression -> Maybe Expression) -> Expression -> Maybe Expression
forall a b. (a -> b) -> a -> b
$ Bool -> Expression
javaBooleanExpression Bool
False
castStmt :: BlockStatement
castStmt = Aliases -> Type -> Identifier -> Expression -> BlockStatement
variableDeclarationStatement Aliases
aliases Type
jtype Identifier
id Expression
rhs
where
jtype :: Type
jtype = Aliases -> Name -> Type
javaTypeFromTypeName Aliases
aliases Name
elName
id :: Identifier
id = FilePath -> Identifier
javaIdentifier FilePath
tmpName
rhs :: Expression
rhs = CastExpression -> Expression
javaCastExpressionToJavaExpression (CastExpression -> Expression) -> CastExpression -> Expression
forall a b. (a -> b) -> a -> b
$ ReferenceType -> UnaryExpression -> CastExpression
javaCastExpression ReferenceType
rt UnaryExpression
var
var :: UnaryExpression
var = Identifier -> UnaryExpression
javaIdentifierToJavaUnaryExpression (Identifier -> UnaryExpression) -> Identifier -> UnaryExpression
forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.Identifier (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
sanitizeJavaName FilePath
otherInstanceName
rt :: ReferenceType
rt = Aliases
-> Bool
-> [TypeArgument]
-> Name
-> Maybe FilePath
-> ReferenceType
nameToJavaReferenceType Aliases
aliases Bool
False [] Name
elName Maybe FilePath
forall a. Maybe a
Nothing
returnAllFieldsEqual :: BlockStatement
returnAllFieldsEqual = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement (Maybe Expression -> Statement) -> Maybe Expression -> Statement
forall a b. (a -> b) -> a -> b
$ Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Expression -> Maybe Expression) -> Expression -> Maybe Expression
forall a b. (a -> b) -> a -> b
$ if [FieldType] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [FieldType]
fields
then Bool -> Expression
javaBooleanExpression Bool
True
else ConditionalAndExpression -> Expression
javaConditionalAndExpressionToJavaExpression (ConditionalAndExpression -> Expression)
-> ConditionalAndExpression -> Expression
forall a b. (a -> b) -> a -> b
$
[InclusiveOrExpression] -> ConditionalAndExpression
Java.ConditionalAndExpression (Name -> InclusiveOrExpression
eqClause (Name -> InclusiveOrExpression)
-> (FieldType -> Name) -> FieldType -> InclusiveOrExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Name
fieldTypeName (FieldType -> InclusiveOrExpression)
-> [FieldType] -> [InclusiveOrExpression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType]
fields)
where
eqClause :: Name -> InclusiveOrExpression
eqClause (Name FilePath
fname) = PostfixExpression -> InclusiveOrExpression
javaPostfixExpressionToJavaInclusiveOrExpression (PostfixExpression -> InclusiveOrExpression)
-> PostfixExpression -> InclusiveOrExpression
forall a b. (a -> b) -> a -> b
$
MethodInvocation -> PostfixExpression
javaMethodInvocationToJavaPostfixExpression (MethodInvocation -> PostfixExpression)
-> MethodInvocation -> PostfixExpression
forall a b. (a -> b) -> a -> b
$ MethodInvocation_Header -> [Expression] -> MethodInvocation
Java.MethodInvocation MethodInvocation_Header
header [Expression
arg]
where
arg :: Expression
arg = ExpressionName -> Expression
javaExpressionNameToJavaExpression (ExpressionName -> Expression) -> ExpressionName -> Expression
forall a b. (a -> b) -> a -> b
$
Identifier -> Identifier -> ExpressionName
fieldExpression (FilePath -> Identifier
javaIdentifier FilePath
tmpName) (FilePath -> Identifier
javaIdentifier FilePath
fname)
header :: MethodInvocation_Header
header = MethodInvocation_Complex -> MethodInvocation_Header
Java.MethodInvocation_HeaderComplex (MethodInvocation_Complex -> MethodInvocation_Header)
-> MethodInvocation_Complex -> MethodInvocation_Header
forall a b. (a -> b) -> a -> b
$ MethodInvocation_Variant
-> [TypeArgument] -> Identifier -> MethodInvocation_Complex
Java.MethodInvocation_Complex MethodInvocation_Variant
var [] (FilePath -> Identifier
Java.Identifier FilePath
equalsMethodName)
var :: MethodInvocation_Variant
var = ExpressionName -> MethodInvocation_Variant
Java.MethodInvocation_VariantExpression (ExpressionName -> MethodInvocation_Variant)
-> ExpressionName -> MethodInvocation_Variant
forall a b. (a -> b) -> a -> b
$ Maybe AmbiguousName -> Identifier -> ExpressionName
Java.ExpressionName Maybe AmbiguousName
forall a. Maybe a
Nothing (Identifier -> ExpressionName) -> Identifier -> ExpressionName
forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.Identifier (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$
FilePath -> FilePath
sanitizeJavaName FilePath
fname
hashCodeMethod :: ClassBodyDeclaration
hashCodeMethod = [MethodModifier]
-> [TypeParameter]
-> [Annotation]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> ClassBodyDeclaration
methodDeclaration [MethodModifier]
mods [] [Annotation]
anns FilePath
hashCodeMethodName [] Result
result (Maybe [BlockStatement] -> ClassBodyDeclaration)
-> Maybe [BlockStatement] -> ClassBodyDeclaration
forall a b. (a -> b) -> a -> b
$ [BlockStatement] -> Maybe [BlockStatement]
forall a. a -> Maybe a
Just [BlockStatement
returnSum]
where
anns :: [Annotation]
anns = [Annotation
overrideAnnotation]
mods :: [MethodModifier]
mods = [MethodModifier
Java.MethodModifierPublic]
result :: Result
result = Type -> Result
javaTypeToJavaResult Type
javaIntType
returnSum :: BlockStatement
returnSum = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ if [FieldType] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [FieldType]
fields
then Statement
returnZero
else Maybe Expression -> Statement
javaReturnStatement (Maybe Expression -> Statement) -> Maybe Expression -> Statement
forall a b. (a -> b) -> a -> b
$ Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Expression -> Maybe Expression) -> Expression -> Maybe Expression
forall a b. (a -> b) -> a -> b
$
AdditiveExpression -> Expression
javaAdditiveExpressionToJavaExpression (AdditiveExpression -> Expression)
-> AdditiveExpression -> Expression
forall a b. (a -> b) -> a -> b
$ [MultiplicativeExpression] -> AdditiveExpression
addExpressions ([MultiplicativeExpression] -> AdditiveExpression)
-> [MultiplicativeExpression] -> AdditiveExpression
forall a b. (a -> b) -> a -> b
$
(Int -> Name -> MultiplicativeExpression)
-> [Int] -> [Name] -> [MultiplicativeExpression]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
L.zipWith Int -> Name -> MultiplicativeExpression
multPair [Int]
multipliers (FieldType -> Name
fieldTypeName (FieldType -> Name) -> [FieldType] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType]
fields)
where
returnZero :: Statement
returnZero = Maybe Expression -> Statement
javaReturnStatement (Maybe Expression -> Statement) -> Maybe Expression -> Statement
forall a b. (a -> b) -> a -> b
$ Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Expression -> Maybe Expression) -> Expression -> Maybe Expression
forall a b. (a -> b) -> a -> b
$ Integer -> Expression
javaIntExpression Integer
0
multPair :: Int -> Name -> Java.MultiplicativeExpression
multPair :: Int -> Name -> MultiplicativeExpression
multPair Int
i (Name FilePath
fname) = MultiplicativeExpression_Binary -> MultiplicativeExpression
Java.MultiplicativeExpressionTimes (MultiplicativeExpression_Binary -> MultiplicativeExpression)
-> MultiplicativeExpression_Binary -> MultiplicativeExpression
forall a b. (a -> b) -> a -> b
$
MultiplicativeExpression
-> UnaryExpression -> MultiplicativeExpression_Binary
Java.MultiplicativeExpression_Binary MultiplicativeExpression
lhs UnaryExpression
rhs
where
lhs :: MultiplicativeExpression
lhs = UnaryExpression -> MultiplicativeExpression
Java.MultiplicativeExpressionUnary (UnaryExpression -> MultiplicativeExpression)
-> UnaryExpression -> MultiplicativeExpression
forall a b. (a -> b) -> a -> b
$ Primary -> UnaryExpression
javaPrimaryToJavaUnaryExpression (Primary -> UnaryExpression) -> Primary -> UnaryExpression
forall a b. (a -> b) -> a -> b
$
Literal -> Primary
javaLiteralToJavaPrimary (Literal -> Primary) -> Literal -> Primary
forall a b. (a -> b) -> a -> b
$ Int -> Literal
forall a. Integral a => a -> Literal
javaInt Int
i
rhs :: UnaryExpression
rhs = PostfixExpression -> UnaryExpression
javaPostfixExpressionToJavaUnaryExpression (PostfixExpression -> UnaryExpression)
-> PostfixExpression -> UnaryExpression
forall a b. (a -> b) -> a -> b
$
MethodInvocation -> PostfixExpression
javaMethodInvocationToJavaPostfixExpression (MethodInvocation -> PostfixExpression)
-> MethodInvocation -> PostfixExpression
forall a b. (a -> b) -> a -> b
$
Identifier -> Identifier -> [Expression] -> MethodInvocation
methodInvocationStatic (FilePath -> Identifier
javaIdentifier FilePath
fname) (FilePath -> Identifier
Java.Identifier FilePath
hashCodeMethodName) []
multipliers :: [Int]
multipliers = [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
L.cycle [Int]
first20Primes
where
first20Primes :: [Int]
first20Primes = [Int
2, Int
3, Int
5, Int
7, Int
11, Int
13, Int
17, Int
19, Int
23, Int
29, Int
31, Int
37, Int
41, Int
43, Int
47, Int
53, Int
59, Int
61, Int
67, Int
71]
declarationForType :: Bool -> Aliases -> (Element, TypedTerm) -> Flow Graph Java.TypeDeclarationWithComments
declarationForType :: Bool
-> Aliases
-> (Element, TypedTerm)
-> Flow Graph TypeDeclarationWithComments
declarationForType Bool
isSer Aliases
aliases (Element
el, TypedTerm Term
term Type
_) = FilePath
-> Flow Graph TypeDeclarationWithComments
-> Flow Graph TypeDeclarationWithComments
forall s a. FilePath -> Flow s a -> Flow s a
withTrace (FilePath
"element " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
unName (Element -> Name
elementName Element
el)) (Flow Graph TypeDeclarationWithComments
-> Flow Graph TypeDeclarationWithComments)
-> Flow Graph TypeDeclarationWithComments
-> Flow Graph TypeDeclarationWithComments
forall a b. (a -> b) -> a -> b
$ do
Type
t <- Term -> Flow Graph Type
coreDecodeType Term
term Flow Graph Type -> (Type -> Flow Graph Type) -> Flow Graph Type
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Language -> Type -> Flow Graph Type
adaptType Language
javaLanguage
ClassDeclaration
cd <- Bool
-> Bool
-> Aliases
-> [TypeParameter]
-> Name
-> Type
-> Flow Graph ClassDeclaration
toClassDecl Bool
False Bool
isSer Aliases
aliases [] (Element -> Name
elementName Element
el) Type
t
Maybe FilePath
comments <- Element -> Flow Graph (Maybe FilePath)
commentsFromElement Element
el
TypeDeclarationWithComments
-> Flow Graph TypeDeclarationWithComments
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeDeclarationWithComments
-> Flow Graph TypeDeclarationWithComments)
-> TypeDeclarationWithComments
-> Flow Graph TypeDeclarationWithComments
forall a b. (a -> b) -> a -> b
$ TypeDeclaration -> Maybe FilePath -> TypeDeclarationWithComments
Java.TypeDeclarationWithComments (ClassDeclaration -> TypeDeclaration
Java.TypeDeclarationClass ClassDeclaration
cd) Maybe FilePath
comments
declarationForUnionType :: Bool -> Aliases
-> [Java.TypeParameter] -> Name -> [FieldType] -> Flow Graph Java.ClassDeclaration
declarationForUnionType :: Bool
-> Aliases
-> [TypeParameter]
-> Name
-> [FieldType]
-> Flow Graph ClassDeclaration
declarationForUnionType Bool
isSer Aliases
aliases [TypeParameter]
tparams Name
elName [FieldType]
fields = do
[ClassDeclaration]
variantClasses <- (FieldType -> Flow Graph ClassDeclaration)
-> [FieldType] -> Flow Graph [ClassDeclaration]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM ((ClassDeclaration -> ClassDeclaration)
-> Flow Graph ClassDeclaration -> Flow Graph ClassDeclaration
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClassDeclaration -> ClassDeclaration
augmentVariantClass (Flow Graph ClassDeclaration -> Flow Graph ClassDeclaration)
-> (FieldType -> Flow Graph ClassDeclaration)
-> FieldType
-> Flow Graph ClassDeclaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Flow Graph ClassDeclaration
unionFieldClass) [FieldType]
fields
let variantDecls :: [ClassBodyDeclaration]
variantDecls = ClassMemberDeclaration -> ClassBodyDeclaration
Java.ClassBodyDeclarationClassMember (ClassMemberDeclaration -> ClassBodyDeclaration)
-> (ClassDeclaration -> ClassMemberDeclaration)
-> ClassDeclaration
-> ClassBodyDeclaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassDeclaration -> ClassMemberDeclaration
Java.ClassMemberDeclarationClass (ClassDeclaration -> ClassBodyDeclaration)
-> [ClassDeclaration] -> [ClassBodyDeclaration]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClassDeclaration]
variantClasses
[ClassBodyDeclarationWithComments]
variantDecls' <- (ClassBodyDeclaration
-> FieldType -> Flow Graph ClassBodyDeclarationWithComments)
-> [ClassBodyDeclaration]
-> [FieldType]
-> Flow Graph [ClassBodyDeclarationWithComments]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
CM.zipWithM ClassBodyDeclaration
-> FieldType -> Flow Graph ClassBodyDeclarationWithComments
addComment [ClassBodyDeclaration]
variantDecls [FieldType]
fields
let otherDecls :: [ClassBodyDeclarationWithComments]
otherDecls = ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment (ClassBodyDeclaration -> ClassBodyDeclarationWithComments)
-> [ClassBodyDeclaration] -> [ClassBodyDeclarationWithComments]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClassBodyDeclaration
privateConstructor, Bool -> [TypeParameter] -> ClassBodyDeclaration
toAcceptMethod Bool
True [TypeParameter]
tparams, ClassBodyDeclaration
visitor, ClassBodyDeclaration
partialVisitor]
[ClassBodyDeclarationWithComments]
tn <- do
ClassBodyDeclarationWithComments
d <- Aliases -> Name -> Flow Graph ClassBodyDeclarationWithComments
constantDeclForTypeName Aliases
aliases Name
elName
[ClassBodyDeclarationWithComments]
dfields <- (FieldType -> Flow Graph ClassBodyDeclarationWithComments)
-> [FieldType] -> Flow Graph [ClassBodyDeclarationWithComments]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Aliases -> FieldType -> Flow Graph ClassBodyDeclarationWithComments
constantDeclForFieldType Aliases
aliases) [FieldType]
fields
[ClassBodyDeclarationWithComments]
-> Flow Graph [ClassBodyDeclarationWithComments]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassBodyDeclarationWithComments
dClassBodyDeclarationWithComments
-> [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
forall a. a -> [a] -> [a]
:[ClassBodyDeclarationWithComments]
dfields)
let bodyDecls :: [ClassBodyDeclarationWithComments]
bodyDecls = [ClassBodyDeclarationWithComments]
tn [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
forall a. [a] -> [a] -> [a]
++ [ClassBodyDeclarationWithComments]
otherDecls [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
forall a. [a] -> [a] -> [a]
++ [ClassBodyDeclarationWithComments]
variantDecls'
let mods :: [ClassModifier]
mods = [ClassModifier]
classModsPublic [ClassModifier] -> [ClassModifier] -> [ClassModifier]
forall a. [a] -> [a] -> [a]
++ [ClassModifier
Java.ClassModifierAbstract]
ClassDeclaration -> Flow Graph ClassDeclaration
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassDeclaration -> Flow Graph ClassDeclaration)
-> ClassDeclaration -> Flow Graph ClassDeclaration
forall a b. (a -> b) -> a -> b
$ Aliases
-> [TypeParameter]
-> Name
-> [ClassModifier]
-> Maybe Name
-> [InterfaceType]
-> [ClassBodyDeclarationWithComments]
-> ClassDeclaration
javaClassDeclaration Aliases
aliases [TypeParameter]
tparams Name
elName [ClassModifier]
mods Maybe Name
forall a. Maybe a
Nothing (Bool -> [InterfaceType]
interfaceTypes Bool
isSer) [ClassBodyDeclarationWithComments]
bodyDecls
where
privateConstructor :: ClassBodyDeclaration
privateConstructor = Aliases
-> Name
-> Bool
-> [FormalParameter]
-> [BlockStatement]
-> ClassBodyDeclaration
makeConstructor Aliases
aliases Name
elName Bool
True [] []
unionFieldClass :: FieldType -> Flow Graph ClassDeclaration
unionFieldClass (FieldType Name
fname Type
ftype) = do
let rtype :: Type
rtype = [FieldType] -> Type
Types.record ([FieldType] -> Type) -> [FieldType] -> Type
forall a b. (a -> b) -> a -> b
$ if Type -> Bool
isUnitType Type
ftype then [] else [Name -> Type -> FieldType
FieldType (FilePath -> Name
Name FilePath
valueFieldName) (Type -> FieldType) -> Type -> FieldType
forall a b. (a -> b) -> a -> b
$ Type -> Type
stripType Type
ftype]
Bool
-> Bool
-> Aliases
-> [TypeParameter]
-> Name
-> Type
-> Flow Graph ClassDeclaration
toClassDecl Bool
True Bool
isSer Aliases
aliases [] (Bool -> Name -> Name -> Name
variantClassName Bool
False Name
elName Name
fname) Type
rtype
augmentVariantClass :: ClassDeclaration -> ClassDeclaration
augmentVariantClass (Java.ClassDeclarationNormal NormalClassDeclaration
cd) = NormalClassDeclaration -> ClassDeclaration
Java.ClassDeclarationNormal (NormalClassDeclaration -> ClassDeclaration)
-> NormalClassDeclaration -> ClassDeclaration
forall a b. (a -> b) -> a -> b
$ NormalClassDeclaration
cd {
Java.normalClassDeclarationModifiers = [Java.ClassModifierPublic, Java.ClassModifierStatic, Java.ClassModifierFinal],
Java.normalClassDeclarationExtends = Just $ nameToJavaClassType aliases True args elName Nothing,
Java.normalClassDeclarationParameters = tparams,
Java.normalClassDeclarationBody = newBody (Java.normalClassDeclarationBody cd)}
where
newBody :: ClassBody -> ClassBody
newBody (Java.ClassBody [ClassBodyDeclarationWithComments]
decls) = [ClassBodyDeclarationWithComments] -> ClassBody
Java.ClassBody ([ClassBodyDeclarationWithComments] -> ClassBody)
-> [ClassBodyDeclarationWithComments] -> ClassBody
forall a b. (a -> b) -> a -> b
$ [ClassBodyDeclarationWithComments]
decls [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
forall a. [a] -> [a] -> [a]
++ [ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment (ClassBodyDeclaration -> ClassBodyDeclarationWithComments)
-> ClassBodyDeclaration -> ClassBodyDeclarationWithComments
forall a b. (a -> b) -> a -> b
$ Bool -> [TypeParameter] -> ClassBodyDeclaration
toAcceptMethod Bool
False [TypeParameter]
tparams]
args :: [TypeArgument]
args = TypeParameter -> TypeArgument
typeParameterToTypeArgument (TypeParameter -> TypeArgument)
-> [TypeParameter] -> [TypeArgument]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeParameter]
tparams
visitor :: ClassBodyDeclaration
visitor = NormalInterfaceDeclaration -> ClassBodyDeclaration
javaInterfaceDeclarationToJavaClassBodyDeclaration (NormalInterfaceDeclaration -> ClassBodyDeclaration)
-> NormalInterfaceDeclaration -> ClassBodyDeclaration
forall a b. (a -> b) -> a -> b
$
[InterfaceModifier]
-> TypeIdentifier
-> [TypeParameter]
-> [InterfaceType]
-> InterfaceBody
-> NormalInterfaceDeclaration
Java.NormalInterfaceDeclaration [InterfaceModifier]
mods TypeIdentifier
ti [TypeParameter]
vtparams [InterfaceType]
forall a. [a]
extends InterfaceBody
body
where
mods :: [InterfaceModifier]
mods = [InterfaceModifier
Java.InterfaceModifierPublic]
ti :: TypeIdentifier
ti = Identifier -> TypeIdentifier
Java.TypeIdentifier (Identifier -> TypeIdentifier) -> Identifier -> TypeIdentifier
forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.Identifier FilePath
visitorName
vtparams :: [TypeParameter]
vtparams = [TypeParameter]
tparams [TypeParameter] -> [TypeParameter] -> [TypeParameter]
forall a. [a] -> [a] -> [a]
++ [FilePath -> TypeParameter
javaTypeParameter FilePath
visitorReturnParameter]
extends :: [a]
extends = []
body :: InterfaceBody
body = [InterfaceMemberDeclaration] -> InterfaceBody
Java.InterfaceBody (Name -> InterfaceMemberDeclaration
toVisitMethod (Name -> InterfaceMemberDeclaration)
-> (FieldType -> Name) -> FieldType -> InterfaceMemberDeclaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Name
fieldTypeName (FieldType -> InterfaceMemberDeclaration)
-> [FieldType] -> [InterfaceMemberDeclaration]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType]
fields)
where
toVisitMethod :: Name -> InterfaceMemberDeclaration
toVisitMethod Name
fname = [InterfaceMethodModifier]
-> [TypeParameter]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> InterfaceMemberDeclaration
interfaceMethodDeclaration [] [] FilePath
visitMethodName [Name -> FormalParameter
variantInstanceParam Name
fname] Result
resultR Maybe [BlockStatement]
forall a. Maybe a
Nothing
partialVisitor :: ClassBodyDeclaration
partialVisitor = NormalInterfaceDeclaration -> ClassBodyDeclaration
javaInterfaceDeclarationToJavaClassBodyDeclaration (NormalInterfaceDeclaration -> ClassBodyDeclaration)
-> NormalInterfaceDeclaration -> ClassBodyDeclaration
forall a b. (a -> b) -> a -> b
$
Java.NormalInterfaceDeclaration {
normalInterfaceDeclarationModifiers :: [InterfaceModifier]
Java.normalInterfaceDeclarationModifiers = [InterfaceModifier
Java.InterfaceModifierPublic],
normalInterfaceDeclarationIdentifier :: TypeIdentifier
Java.normalInterfaceDeclarationIdentifier = Identifier -> TypeIdentifier
Java.TypeIdentifier (Identifier -> TypeIdentifier) -> Identifier -> TypeIdentifier
forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.Identifier FilePath
partialVisitorName,
normalInterfaceDeclarationParameters :: [TypeParameter]
Java.normalInterfaceDeclarationParameters = [TypeParameter]
tparams [TypeParameter] -> [TypeParameter] -> [TypeParameter]
forall a. [a] -> [a] -> [a]
++ [FilePath -> TypeParameter
javaTypeParameter FilePath
visitorReturnParameter],
normalInterfaceDeclarationExtends :: [InterfaceType]
Java.normalInterfaceDeclarationExtends =
[ClassType -> InterfaceType
Java.InterfaceType (ClassType -> InterfaceType) -> ClassType -> InterfaceType
forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> ClassType
javaClassType ((TypeParameter -> ReferenceType
typeParameterToReferenceType (TypeParameter -> ReferenceType)
-> [TypeParameter] -> [ReferenceType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeParameter]
tparams) [ReferenceType] -> [ReferenceType] -> [ReferenceType]
forall a. [a] -> [a] -> [a]
++ [ReferenceType
visitorTypeVariable]) Maybe PackageName
forall a. Maybe a
Nothing FilePath
visitorName],
normalInterfaceDeclarationBody :: InterfaceBody
Java.normalInterfaceDeclarationBody = [InterfaceMemberDeclaration] -> InterfaceBody
Java.InterfaceBody ([InterfaceMemberDeclaration] -> InterfaceBody)
-> [InterfaceMemberDeclaration] -> InterfaceBody
forall a b. (a -> b) -> a -> b
$ InterfaceMemberDeclaration
otherwiseInterfaceMemberDeclaration
-> [InterfaceMemberDeclaration] -> [InterfaceMemberDeclaration]
forall a. a -> [a] -> [a]
:(Name -> InterfaceMemberDeclaration
toVisitMethod (Name -> InterfaceMemberDeclaration)
-> (FieldType -> Name) -> FieldType -> InterfaceMemberDeclaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Name
fieldTypeName (FieldType -> InterfaceMemberDeclaration)
-> [FieldType] -> [InterfaceMemberDeclaration]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType]
fields)}
where
otherwise :: InterfaceMemberDeclaration
otherwise = [InterfaceMethodModifier]
-> [TypeParameter]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> InterfaceMemberDeclaration
interfaceMethodDeclaration [InterfaceMethodModifier]
defaultMod [] FilePath
otherwiseMethodName [FormalParameter
mainInstanceParam] Result
resultR (Maybe [BlockStatement] -> InterfaceMemberDeclaration)
-> Maybe [BlockStatement] -> InterfaceMemberDeclaration
forall a b. (a -> b) -> a -> b
$ [BlockStatement] -> Maybe [BlockStatement]
forall a. a -> Maybe a
Just [BlockStatement
throw]
where
typeArgs :: [TypeArgument]
typeArgs = TypeParameter -> TypeArgument
typeParameterToTypeArgument (TypeParameter -> TypeArgument)
-> [TypeParameter] -> [TypeArgument]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeParameter]
tparams
throw :: BlockStatement
throw = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ [Expression] -> Statement
javaThrowIllegalStateException [Expression]
args
where
args :: [Expression]
args = [AdditiveExpression -> Expression
javaAdditiveExpressionToJavaExpression (AdditiveExpression -> Expression)
-> AdditiveExpression -> Expression
forall a b. (a -> b) -> a -> b
$ [MultiplicativeExpression] -> AdditiveExpression
addExpressions [
FilePath -> MultiplicativeExpression
javaStringMultiplicativeExpression FilePath
"Non-exhaustive patterns when matching: ",
UnaryExpression -> MultiplicativeExpression
Java.MultiplicativeExpressionUnary (UnaryExpression -> MultiplicativeExpression)
-> UnaryExpression -> MultiplicativeExpression
forall a b. (a -> b) -> a -> b
$ Identifier -> UnaryExpression
javaIdentifierToJavaUnaryExpression (Identifier -> UnaryExpression) -> Identifier -> UnaryExpression
forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.Identifier FilePath
"instance"]]
toVisitMethod :: Name -> InterfaceMemberDeclaration
toVisitMethod Name
fname = [InterfaceMethodModifier]
-> [TypeParameter]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> InterfaceMemberDeclaration
interfaceMethodDeclaration [InterfaceMethodModifier]
defaultMod [] FilePath
visitMethodName [Name -> FormalParameter
variantInstanceParam Name
fname] Result
resultR (Maybe [BlockStatement] -> InterfaceMemberDeclaration)
-> Maybe [BlockStatement] -> InterfaceMemberDeclaration
forall a b. (a -> b) -> a -> b
$
[BlockStatement] -> Maybe [BlockStatement]
forall a. a -> Maybe a
Just [BlockStatement
returnOtherwise]
where
returnOtherwise :: BlockStatement
returnOtherwise = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement (Maybe Expression -> Statement) -> Maybe Expression -> Statement
forall a b. (a -> b) -> a -> b
$ Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Expression -> Maybe Expression) -> Expression -> Maybe Expression
forall a b. (a -> b) -> a -> b
$
Primary -> Expression
javaPrimaryToJavaExpression (Primary -> Expression) -> Primary -> Expression
forall a b. (a -> b) -> a -> b
$ PrimaryNoNewArray -> Primary
Java.PrimaryNoNewArray (PrimaryNoNewArray -> Primary) -> PrimaryNoNewArray -> Primary
forall a b. (a -> b) -> a -> b
$ MethodInvocation -> PrimaryNoNewArray
Java.PrimaryNoNewArrayMethodInvocation (MethodInvocation -> PrimaryNoNewArray)
-> MethodInvocation -> PrimaryNoNewArray
forall a b. (a -> b) -> a -> b
$
Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation Maybe (Either ExpressionName Primary)
forall a. Maybe a
Nothing (FilePath -> Identifier
Java.Identifier FilePath
otherwiseMethodName) [Identifier -> Expression
javaIdentifierToJavaExpression (Identifier -> Expression) -> Identifier -> Expression
forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.Identifier FilePath
"instance"]
defaultMod :: [InterfaceMethodModifier]
defaultMod = [InterfaceMethodModifier
Java.InterfaceMethodModifierDefault]
resultR :: Result
resultR = Type -> Result
javaTypeToJavaResult (Type -> Result) -> Type -> Result
forall a b. (a -> b) -> a -> b
$ ReferenceType -> Type
Java.TypeReference ReferenceType
visitorTypeVariable
typeArgs :: [TypeArgument]
typeArgs = TypeParameter -> TypeArgument
typeParameterToTypeArgument (TypeParameter -> TypeArgument)
-> [TypeParameter] -> [TypeArgument]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeParameter]
tparams
mainInstanceParam :: FormalParameter
mainInstanceParam = Type -> Name -> FormalParameter
javaTypeToJavaFormalParameter Type
classRef (Name -> FormalParameter) -> Name -> FormalParameter
forall a b. (a -> b) -> a -> b
$ FilePath -> Name
Name FilePath
instanceName
where
classRef :: Type
classRef = ClassType -> Type
javaClassTypeToJavaType (ClassType -> Type) -> ClassType -> Type
forall a b. (a -> b) -> a -> b
$
Aliases
-> Bool -> [TypeArgument] -> Name -> Maybe FilePath -> ClassType
nameToJavaClassType Aliases
aliases Bool
False [TypeArgument]
typeArgs Name
elName Maybe FilePath
forall a. Maybe a
Nothing
variantInstanceParam :: Name -> FormalParameter
variantInstanceParam Name
fname = Type -> Name -> FormalParameter
javaTypeToJavaFormalParameter Type
classRef (Name -> FormalParameter) -> Name -> FormalParameter
forall a b. (a -> b) -> a -> b
$ FilePath -> Name
Name FilePath
instanceName
where
classRef :: Type
classRef = ClassType -> Type
javaClassTypeToJavaType (ClassType -> Type) -> ClassType -> Type
forall a b. (a -> b) -> a -> b
$
Aliases
-> Bool -> [TypeArgument] -> Name -> Maybe FilePath -> ClassType
nameToJavaClassType Aliases
aliases Bool
False [TypeArgument]
typeArgs (Bool -> Name -> Name -> Name
variantClassName Bool
False Name
elName Name
fname) Maybe FilePath
forall a. Maybe a
Nothing
elementJavaIdentifier :: Bool -> Bool -> Aliases -> Name -> Java.Identifier
elementJavaIdentifier :: Bool -> Bool -> Aliases -> Name -> Identifier
elementJavaIdentifier Bool
isPrim Bool
isMethod Aliases
aliases Name
name = FilePath -> Identifier
Java.Identifier (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ if Bool
isPrim
then (FilePath -> FilePath
qualify (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
capitalize FilePath
local) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
applyMethodName
else case Maybe Namespace
ns of
Maybe Namespace
Nothing -> FilePath
local
Just Namespace
n -> (FilePath -> FilePath
qualify (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Namespace -> FilePath
elementsClassName Namespace
n) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
sep FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
local
where
sep :: FilePath
sep = if Bool
isMethod then FilePath
"::" else FilePath
"."
qualify :: FilePath -> FilePath
qualify FilePath
s = Identifier -> FilePath
Java.unIdentifier (Identifier -> FilePath) -> Identifier -> FilePath
forall a b. (a -> b) -> a -> b
$ Aliases -> Name -> Identifier
nameToJavaName Aliases
aliases (Name -> Identifier) -> Name -> Identifier
forall a b. (a -> b) -> a -> b
$ QualifiedName -> Name
unqualifyName (QualifiedName -> Name) -> QualifiedName -> Name
forall a b. (a -> b) -> a -> b
$ Maybe Namespace -> FilePath -> QualifiedName
QualifiedName Maybe Namespace
ns FilePath
s
QualifiedName Maybe Namespace
ns FilePath
local = Name -> QualifiedName
qualifyNameEager Name
name
elementNameToFilePath :: Name -> FilePath
elementNameToFilePath :: Name -> FilePath
elementNameToFilePath Name
name = Bool -> FileExtension -> Name -> FilePath
nameToFilePath Bool
False (FilePath -> FileExtension
FileExtension FilePath
"java") (Name -> FilePath) -> Name -> FilePath
forall a b. (a -> b) -> a -> b
$ QualifiedName -> Name
unqualifyName (QualifiedName -> Name) -> QualifiedName -> Name
forall a b. (a -> b) -> a -> b
$ Maybe Namespace -> FilePath -> QualifiedName
QualifiedName Maybe Namespace
ns (FilePath -> FilePath
sanitizeJavaName FilePath
local)
where
QualifiedName Maybe Namespace
ns FilePath
local = Name -> QualifiedName
qualifyNameEager Name
name
elementsClassName :: Namespace -> String
elementsClassName :: Namespace -> FilePath
elementsClassName (Namespace FilePath
ns) = FilePath -> FilePath
capitalize (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. HasCallStack => [a] -> a
L.last ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
LS.splitOn FilePath
"/" FilePath
ns
encodeApplication :: Aliases -> Application -> Flow Graph Java.Expression
encodeApplication :: Aliases -> Application -> Flow Graph Expression
encodeApplication Aliases
aliases app :: Application
app@(Application Term
lhs Term
rhs) = case Term -> Term
fullyStripTerm Term
fun of
TermFunction Function
f -> case Function
f of
FunctionPrimitive Name
name -> Aliases -> Bool -> Name -> [Term] -> Flow Graph Expression
functionCall Aliases
aliases Bool
True Name
name [Term]
args
Function
_ -> Flow Graph Expression
fallback
TermVariable Name
name -> do
Expression
firstCall <- Aliases -> Bool -> Name -> [Term] -> Flow Graph Expression
functionCall Aliases
aliases Bool
False Name
name [[Term] -> Term
forall a. HasCallStack => [a] -> a
L.head [Term]
args]
Expression -> [Term] -> Flow Graph Expression
calls Expression
firstCall ([Term] -> Flow Graph Expression)
-> [Term] -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ [Term] -> [Term]
forall a. HasCallStack => [a] -> [a]
L.tail [Term]
args
where
calls :: Expression -> [Term] -> Flow Graph Expression
calls Expression
exp [Term]
args = case [Term]
args of
[] -> Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
exp
(Term
h:[Term]
r) -> do
Expression
jarg <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases Term
h
Expression -> [Term] -> Flow Graph Expression
calls (Expression -> Expression -> Expression
apply Expression
exp Expression
jarg) [Term]
r
Term
_ -> Flow Graph Expression
fallback
where
(Term
fun, [Term]
args) = [Term] -> Term -> Term -> (Term, [Term])
uncurry [] Term
lhs Term
rhs
where
uncurry :: [Term] -> Term -> Term -> (Term, [Term])
uncurry [Term]
args Term
lhs Term
rhs = case Term -> Term
fullyStripTerm Term
lhs of
TermApplication (Application Term
lhs' Term
rhs') -> [Term] -> Term -> Term -> (Term, [Term])
uncurry (Term
rhsTerm -> [Term] -> [Term]
forall a. a -> [a] -> [a]
:[Term]
args) Term
lhs' Term
rhs'
Term
_ -> (Term
lhs, (Term
rhsTerm -> [Term] -> [Term]
forall a. a -> [a] -> [a]
:[Term]
args))
fallback :: Flow Graph Expression
fallback = FilePath -> Flow Graph Expression -> Flow Graph Expression
forall s a. FilePath -> Flow s a -> Flow s a
withTrace FilePath
"fallback" (Flow Graph Expression -> Flow Graph Expression)
-> Flow Graph Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ do
if Maybe Type -> Bool
forall a. Maybe a -> Bool
Y.isNothing (Term -> Maybe Type
getTermType Term
lhs)
then FilePath -> Flow Graph ()
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Flow Graph ()) -> FilePath -> Flow Graph ()
forall a b. (a -> b) -> a -> b
$ FilePath
"lhs: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Term -> FilePath
showTerm Term
lhs
else () -> Flow Graph ()
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Type
t <- Term -> Flow Graph Type
requireTermType Term
lhs
(Type
dom, Type
cod) <- case Type -> Type
stripTypeParameters (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
stripType Type
t of
TypeFunction (FunctionType Type
dom Type
cod) -> (Type, Type) -> Flow Graph (Type, Type)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type
dom, Type
cod)
Type
t' -> FilePath -> Flow Graph (Type, Type)
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Flow Graph (Type, Type))
-> FilePath -> Flow Graph (Type, Type)
forall a b. (a -> b) -> a -> b
$ FilePath
"expected a function type on function " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Term -> FilePath
forall a. Show a => a -> FilePath
show Term
lhs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", but found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
t'
case Term -> Term
fullyStripTerm Term
lhs of
TermFunction Function
f -> case Function
f of
FunctionElimination Elimination
e -> do
Expression
jarg <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases Term
rhs
Aliases
-> Maybe Expression
-> Type
-> Type
-> Elimination
-> Flow Graph Expression
encodeElimination Aliases
aliases (Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
jarg) Type
dom Type
cod Elimination
e
Function
_ -> Flow Graph Expression
defaultExpression
Term
_ -> Flow Graph Expression
defaultExpression
where
defaultExpression :: Flow Graph Expression
defaultExpression = do
Expression
jfun <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases Term
lhs
Expression
jarg <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases Term
rhs
let prim :: Primary
prim = Expression -> Primary
javaExpressionToJavaPrimary Expression
jfun
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ Expression -> Expression -> Expression
apply Expression
jfun Expression
jarg
apply :: Expression -> Expression -> Expression
apply Expression
exp Expression
jarg = MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$
Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a. a -> Maybe a
Just (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary))
-> Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a b. (a -> b) -> a -> b
$ Primary -> Either ExpressionName Primary
forall a b. b -> Either a b
Right (Primary -> Either ExpressionName Primary)
-> Primary -> Either ExpressionName Primary
forall a b. (a -> b) -> a -> b
$ Expression -> Primary
javaExpressionToJavaPrimary Expression
exp) (FilePath -> Identifier
Java.Identifier FilePath
applyMethodName) [Expression
jarg]
encodeElimination :: Aliases -> Maybe Java.Expression -> Type -> Type -> Elimination -> Flow Graph Java.Expression
encodeElimination :: Aliases
-> Maybe Expression
-> Type
-> Type
-> Elimination
-> Flow Graph Expression
encodeElimination Aliases
aliases Maybe Expression
marg Type
dom Type
cod Elimination
elm = case Elimination
elm of
EliminationOptional (OptionalCases Term
nothing Term
just) -> do
Expression
jnothing <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases Term
nothing
Expression
jjust <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases Term
just
let var :: Name
var = FilePath -> Name
Name FilePath
"m"
let jobj :: Either ExpressionName Primary
jobj = case Maybe Expression
marg of
Maybe Expression
Nothing -> ExpressionName -> Either ExpressionName Primary
forall a b. a -> Either a b
Left (ExpressionName -> Either ExpressionName Primary)
-> ExpressionName -> Either ExpressionName Primary
forall a b. (a -> b) -> a -> b
$ Identifier -> ExpressionName
javaIdentifierToJavaExpressionName (Identifier -> ExpressionName) -> Identifier -> ExpressionName
forall a b. (a -> b) -> a -> b
$ Name -> Identifier
variableToJavaIdentifier Name
var
Just Expression
jarg -> Primary -> Either ExpressionName Primary
forall a b. b -> Either a b
Right (Primary -> Either ExpressionName Primary)
-> Primary -> Either ExpressionName Primary
forall a b. (a -> b) -> a -> b
$ Expression -> Primary
javaExpressionToJavaPrimary Expression
jarg
let jhead :: Expression
jhead = MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$ Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation
(Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a. a -> Maybe a
Just Either ExpressionName Primary
jobj)
(FilePath -> Identifier
Java.Identifier FilePath
"map") [Expression
jjust]
let jbody :: Expression
jbody = MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$ Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation
(Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a. a -> Maybe a
Just (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary))
-> Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a b. (a -> b) -> a -> b
$ Primary -> Either ExpressionName Primary
forall a b. b -> Either a b
Right (Primary -> Either ExpressionName Primary)
-> Primary -> Either ExpressionName Primary
forall a b. (a -> b) -> a -> b
$ Expression -> Primary
javaExpressionToJavaPrimary Expression
jhead)
(FilePath -> Identifier
Java.Identifier FilePath
"orElse") [Expression
jnothing]
ReferenceType
castType <- Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases (FunctionType -> Type
TypeFunction (FunctionType -> Type) -> FunctionType -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> FunctionType
FunctionType Type
dom Type
cod) Flow Graph Type
-> (Type -> Flow Graph ReferenceType) -> Flow Graph ReferenceType
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ case Maybe Expression
marg of
Maybe Expression
Nothing -> CastExpression -> Expression
javaCastExpressionToJavaExpression (CastExpression -> Expression) -> CastExpression -> Expression
forall a b. (a -> b) -> a -> b
$ ReferenceType -> UnaryExpression -> CastExpression
javaCastExpression ReferenceType
castType (UnaryExpression -> CastExpression)
-> UnaryExpression -> CastExpression
forall a b. (a -> b) -> a -> b
$
Expression -> UnaryExpression
javaExpressionToJavaUnaryExpression (Expression -> UnaryExpression) -> Expression -> UnaryExpression
forall a b. (a -> b) -> a -> b
$ Name -> Expression -> Expression
javaLambda Name
var Expression
jbody
Just Expression
_ -> Expression
jbody
EliminationRecord (Projection Name
_ Name
fname) -> do
ReferenceType
jdomr <- Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases Type
dom Flow Graph Type
-> (Type -> Flow Graph ReferenceType) -> Flow Graph ReferenceType
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType
Expression
jexp <- case Maybe Expression
marg of
Maybe Expression
Nothing -> Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ Name -> Expression -> Expression
javaLambda Name
var Expression
jbody
where
var :: Name
var = FilePath -> Name
Name FilePath
"r"
jbody :: Expression
jbody = ExpressionName -> Expression
javaExpressionNameToJavaExpression (ExpressionName -> Expression) -> ExpressionName -> Expression
forall a b. (a -> b) -> a -> b
$
Identifier -> Identifier -> ExpressionName
fieldExpression (Name -> Identifier
variableToJavaIdentifier Name
var) (FilePath -> Identifier
javaIdentifier (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
unName Name
fname)
Just Expression
jarg -> Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ FieldAccess -> Expression
javaFieldAccessToJavaExpression (FieldAccess -> Expression) -> FieldAccess -> Expression
forall a b. (a -> b) -> a -> b
$ FieldAccess_Qualifier -> Identifier -> FieldAccess
Java.FieldAccess FieldAccess_Qualifier
qual (FilePath -> Identifier
javaIdentifier (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
unName Name
fname)
where
qual :: FieldAccess_Qualifier
qual = Primary -> FieldAccess_Qualifier
Java.FieldAccess_QualifierPrimary (Primary -> FieldAccess_Qualifier)
-> Primary -> FieldAccess_Qualifier
forall a b. (a -> b) -> a -> b
$ Expression -> Primary
javaExpressionToJavaPrimary Expression
jarg
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Expression
jexp
EliminationProduct (TupleProjection Int
arity Int
idx) -> if Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
javaMaxTupleLength
then FilePath -> Flow Graph Expression
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Flow Graph Expression)
-> FilePath -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ FilePath
"Tuple eliminations of arity greater than " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
javaMaxTupleLength FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" are unsupported"
else Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ case Maybe Expression
marg of
Maybe Expression
Nothing -> Name -> Expression -> Expression
javaLambda Name
var (Expression -> Expression) -> Expression -> Expression
forall a b. (a -> b) -> a -> b
$ Expression -> Expression
accessExpr (Expression -> Expression) -> Expression -> Expression
forall a b. (a -> b) -> a -> b
$ Identifier -> Expression
javaIdentifierToJavaExpression (Identifier -> Expression) -> Identifier -> Expression
forall a b. (a -> b) -> a -> b
$ Name -> Identifier
variableToJavaIdentifier Name
var
where
var :: Name
var = FilePath -> Name
Name FilePath
"w"
Just Expression
jarg -> Expression -> Expression
accessExpr Expression
jarg
where
accessExpr :: Expression -> Expression
accessExpr Expression
jarg = FieldAccess -> Expression
javaFieldAccessToJavaExpression (FieldAccess -> Expression) -> FieldAccess -> Expression
forall a b. (a -> b) -> a -> b
$ FieldAccess_Qualifier -> Identifier -> FieldAccess
Java.FieldAccess FieldAccess_Qualifier
qual Identifier
accessor
where
accessor :: Identifier
accessor = FilePath -> Identifier
javaIdentifier (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ FilePath
"object" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
qual :: FieldAccess_Qualifier
qual = Primary -> FieldAccess_Qualifier
Java.FieldAccess_QualifierPrimary (Primary -> FieldAccess_Qualifier)
-> Primary -> FieldAccess_Qualifier
forall a b. (a -> b) -> a -> b
$ Expression -> Primary
javaExpressionToJavaPrimary Expression
jarg
EliminationUnion (CaseStatement Name
tname Maybe Term
def [Field]
fields) -> do
case Maybe Expression
marg of
Maybe Expression
Nothing -> do
Graph
g <- Flow Graph Graph
forall s. Flow s s
getState
let lhs :: Term
lhs = Maybe Type -> Term -> Term
setTermType (Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
Types.function (Name -> Type
TypeVariable Name
tname) Type
cod) (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ Elimination -> Term
Terms.elimination Elimination
elm
let var :: FilePath
var = FilePath
"u"
Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases (Term -> Flow Graph Expression) -> Term -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ FilePath -> Term -> Term
Terms.lambda FilePath
var (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ Term -> Term -> Term
Terms.apply Term
lhs (FilePath -> Term
Terms.var FilePath
var)
Just Expression
jarg -> Expression -> Flow Graph Expression
applyElimination Expression
jarg
where
applyElimination :: Expression -> Flow Graph Expression
applyElimination Expression
jarg = do
let prim :: Primary
prim = Expression -> Primary
javaExpressionToJavaPrimary Expression
jarg
let consId :: Identifier
consId = Aliases -> Name -> FilePath -> Identifier
innerClassRef Aliases
aliases Name
tname (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ case Maybe Term
def of
Maybe Term
Nothing -> FilePath
visitorName
Just Term
_ -> FilePath
partialVisitorName
Type
jcod <- Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases Type
cod
ReferenceType
rt <- Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType Type
jcod
let targs :: TypeArgumentsOrDiamond
targs = [TypeArgument] -> TypeArgumentsOrDiamond
typeArgsOrDiamond ([TypeArgument] -> TypeArgumentsOrDiamond)
-> [TypeArgument] -> TypeArgumentsOrDiamond
forall a b. (a -> b) -> a -> b
$ Type -> [TypeArgument]
javaTypeArgumentsForType Type
dom [TypeArgument] -> [TypeArgument] -> [TypeArgument]
forall a. [a] -> [a] -> [a]
++ [ReferenceType -> TypeArgument
Java.TypeArgumentReference ReferenceType
rt]
[ClassBodyDeclarationWithComments]
otherwiseBranches <- case Maybe Term
def of
Maybe Term
Nothing -> [ClassBodyDeclarationWithComments]
-> Flow Graph [ClassBodyDeclarationWithComments]
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just Term
d -> do
ClassBodyDeclarationWithComments
b <- Type -> Term -> Flow Graph ClassBodyDeclarationWithComments
otherwiseBranch Type
jcod Term
d
[ClassBodyDeclarationWithComments]
-> Flow Graph [ClassBodyDeclarationWithComments]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return [ClassBodyDeclarationWithComments
b]
[ClassBodyDeclarationWithComments]
visitBranches <- (Field -> Flow Graph ClassBodyDeclarationWithComments)
-> [Field] -> Flow Graph [ClassBodyDeclarationWithComments]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Type -> Field -> Flow Graph ClassBodyDeclarationWithComments
visitBranch Type
jcod) [Field]
fields
let body :: ClassBody
body = [ClassBodyDeclarationWithComments] -> ClassBody
Java.ClassBody ([ClassBodyDeclarationWithComments] -> ClassBody)
-> [ClassBodyDeclarationWithComments] -> ClassBody
forall a b. (a -> b) -> a -> b
$ [ClassBodyDeclarationWithComments]
otherwiseBranches [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
-> [ClassBodyDeclarationWithComments]
forall a. [a] -> [a] -> [a]
++ [ClassBodyDeclarationWithComments]
visitBranches
let visitor :: Expression
visitor = ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName Identifier
consId (Maybe TypeArgumentsOrDiamond -> ClassOrInterfaceTypeToInstantiate)
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
forall a b. (a -> b) -> a -> b
$ TypeArgumentsOrDiamond -> Maybe TypeArgumentsOrDiamond
forall a. a -> Maybe a
Just TypeArgumentsOrDiamond
targs) [] (ClassBody -> Maybe ClassBody
forall a. a -> Maybe a
Just ClassBody
body)
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$
Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a. a -> Maybe a
Just (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary))
-> Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a b. (a -> b) -> a -> b
$ Primary -> Either ExpressionName Primary
forall a b. b -> Either a b
Right Primary
prim) (FilePath -> Identifier
Java.Identifier FilePath
acceptMethodName) [Expression
visitor]
where
otherwiseBranch :: Type -> Term -> Flow Graph ClassBodyDeclarationWithComments
otherwiseBranch Type
jcod Term
d = do
[TypeArgument]
targs <- Name -> Flow Graph [TypeArgument]
javaTypeArgumentsForNamedType Name
tname
let jdom :: Type
jdom = ReferenceType -> Type
Java.TypeReference (ReferenceType -> Type) -> ReferenceType -> Type
forall a b. (a -> b) -> a -> b
$ Aliases
-> Bool
-> [TypeArgument]
-> Name
-> Maybe FilePath
-> ReferenceType
nameToJavaReferenceType Aliases
aliases Bool
True [TypeArgument]
targs Name
tname Maybe FilePath
forall a. Maybe a
Nothing
let mods :: [MethodModifier]
mods = [MethodModifier
Java.MethodModifierPublic]
let anns :: [Annotation]
anns = [Annotation
overrideAnnotation]
let param :: FormalParameter
param = Type -> Name -> FormalParameter
javaTypeToJavaFormalParameter Type
jdom (Name -> FormalParameter) -> Name -> FormalParameter
forall a b. (a -> b) -> a -> b
$ FilePath -> Name
Name FilePath
instanceName
let result :: Result
result = UnannType -> Result
Java.ResultType (UnannType -> Result) -> UnannType -> Result
forall a b. (a -> b) -> a -> b
$ Type -> UnannType
Java.UnannType Type
jcod
Expression
jret <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases Term
d
let returnStmt :: BlockStatement
returnStmt = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement (Maybe Expression -> Statement) -> Maybe Expression -> Statement
forall a b. (a -> b) -> a -> b
$ Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
jret
ClassBodyDeclarationWithComments
-> Flow Graph ClassBodyDeclarationWithComments
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassBodyDeclarationWithComments
-> Flow Graph ClassBodyDeclarationWithComments)
-> ClassBodyDeclarationWithComments
-> Flow Graph ClassBodyDeclarationWithComments
forall a b. (a -> b) -> a -> b
$ ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment (ClassBodyDeclaration -> ClassBodyDeclarationWithComments)
-> ClassBodyDeclaration -> ClassBodyDeclarationWithComments
forall a b. (a -> b) -> a -> b
$ [MethodModifier]
-> [TypeParameter]
-> [Annotation]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> ClassBodyDeclaration
methodDeclaration [MethodModifier]
mods [] [Annotation]
anns FilePath
otherwiseMethodName [FormalParameter
param] Result
result ([BlockStatement] -> Maybe [BlockStatement]
forall a. a -> Maybe a
Just [BlockStatement
returnStmt])
visitBranch :: Type -> Field -> Flow Graph ClassBodyDeclarationWithComments
visitBranch Type
jcod Field
field = do
[TypeArgument]
targs <- Name -> Flow Graph [TypeArgument]
javaTypeArgumentsForNamedType Name
tname
let jdom :: Type
jdom = ReferenceType -> Type
Java.TypeReference (ReferenceType -> Type) -> ReferenceType -> Type
forall a b. (a -> b) -> a -> b
$ Aliases
-> Bool
-> [TypeArgument]
-> Name
-> Maybe FilePath
-> ReferenceType
nameToJavaReferenceType Aliases
aliases Bool
True [TypeArgument]
targs Name
tname (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
capitalize (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
unName (Name -> FilePath) -> Name -> FilePath
forall a b. (a -> b) -> a -> b
$ Field -> Name
fieldName Field
field)
let mods :: [MethodModifier]
mods = [MethodModifier
Java.MethodModifierPublic]
let anns :: [Annotation]
anns = [Annotation
overrideAnnotation]
let param :: FormalParameter
param = Type -> Name -> FormalParameter
javaTypeToJavaFormalParameter Type
jdom (Name -> FormalParameter) -> Name -> FormalParameter
forall a b. (a -> b) -> a -> b
$ FilePath -> Name
Name FilePath
instanceName
let result :: Result
result = UnannType -> Result
Java.ResultType (UnannType -> Result) -> UnannType -> Result
forall a b. (a -> b) -> a -> b
$ Type -> UnannType
Java.UnannType Type
jcod
let value :: Term
value = FilePath -> Term
Terms.var (FilePath
"$" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
instanceName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
valueFieldName)
Expression
jret <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases (Term -> Flow Graph Expression) -> Term -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ Term -> Term
contractTerm (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ Term -> Term -> Term
Terms.apply (Field -> Term
fieldTerm Field
field) Term
value
let returnStmt :: BlockStatement
returnStmt = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement (Maybe Expression -> Statement) -> Maybe Expression -> Statement
forall a b. (a -> b) -> a -> b
$ Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
jret
ClassBodyDeclarationWithComments
-> Flow Graph ClassBodyDeclarationWithComments
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassBodyDeclarationWithComments
-> Flow Graph ClassBodyDeclarationWithComments)
-> ClassBodyDeclarationWithComments
-> Flow Graph ClassBodyDeclarationWithComments
forall a b. (a -> b) -> a -> b
$ ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment (ClassBodyDeclaration -> ClassBodyDeclarationWithComments)
-> ClassBodyDeclaration -> ClassBodyDeclarationWithComments
forall a b. (a -> b) -> a -> b
$ [MethodModifier]
-> [TypeParameter]
-> [Annotation]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> ClassBodyDeclaration
methodDeclaration [MethodModifier]
mods [] [Annotation]
anns FilePath
visitMethodName [FormalParameter
param] Result
result ([BlockStatement] -> Maybe [BlockStatement]
forall a. a -> Maybe a
Just [BlockStatement
returnStmt])
EliminationWrap Name
name -> case Maybe Expression
marg of
Maybe Expression
Nothing -> Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ Name -> Expression -> Expression
javaLambda Name
var Expression
jbody
where
var :: Name
var = FilePath -> Name
Name FilePath
"w"
arg :: Expression
arg = Identifier -> Expression
javaIdentifierToJavaExpression (Identifier -> Expression) -> Identifier -> Expression
forall a b. (a -> b) -> a -> b
$ Name -> Identifier
variableToJavaIdentifier Name
var
jbody :: Expression
jbody = ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName (Aliases -> Name -> Identifier
nameToJavaName Aliases
aliases Name
name) Maybe TypeArgumentsOrDiamond
forall a. Maybe a
Nothing) [Expression
arg] Maybe ClassBody
forall a. Maybe a
Nothing
Just Expression
jarg -> Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ FieldAccess -> Expression
javaFieldAccessToJavaExpression (FieldAccess -> Expression) -> FieldAccess -> Expression
forall a b. (a -> b) -> a -> b
$ FieldAccess_Qualifier -> Identifier -> FieldAccess
Java.FieldAccess FieldAccess_Qualifier
qual (FilePath -> Identifier
javaIdentifier FilePath
valueFieldName)
where
qual :: FieldAccess_Qualifier
qual = Primary -> FieldAccess_Qualifier
Java.FieldAccess_QualifierPrimary (Primary -> FieldAccess_Qualifier)
-> Primary -> FieldAccess_Qualifier
forall a b. (a -> b) -> a -> b
$ Expression -> Primary
javaExpressionToJavaPrimary Expression
jarg
Elimination
_ -> Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ Literal -> Expression
encodeLiteral (Literal -> Expression) -> Literal -> Expression
forall a b. (a -> b) -> a -> b
$ FilePath -> Literal
LiteralString (FilePath -> Literal) -> FilePath -> Literal
forall a b. (a -> b) -> a -> b
$
FilePath
"Unimplemented elimination variant: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ EliminationVariant -> FilePath
forall a. Show a => a -> FilePath
show (Elimination -> EliminationVariant
eliminationVariant Elimination
elm)
encodeFunction :: Aliases -> Type -> Type -> Function -> Flow Graph Java.Expression
encodeFunction :: Aliases -> Type -> Type -> Function -> Flow Graph Expression
encodeFunction Aliases
aliases Type
dom Type
cod Function
fun = case Function
fun of
FunctionElimination Elimination
elm -> FilePath -> Flow Graph Expression -> Flow Graph Expression
forall s a. FilePath -> Flow s a -> Flow s a
withTrace (FilePath
"elimination (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ EliminationVariant -> FilePath
forall a. Show a => a -> FilePath
show (Elimination -> EliminationVariant
eliminationVariant Elimination
elm) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")") (Flow Graph Expression -> Flow Graph Expression)
-> Flow Graph Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ do
Aliases
-> Maybe Expression
-> Type
-> Type
-> Elimination
-> Flow Graph Expression
encodeElimination Aliases
aliases Maybe Expression
forall a. Maybe a
Nothing Type
dom Type
cod Elimination
elm
FunctionLambda (Lambda Name
var Maybe Type
_ Term
body) -> FilePath -> Flow Graph Expression -> Flow Graph Expression
forall s a. FilePath -> Flow s a -> Flow s a
withTrace (FilePath
"lambda " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
unName Name
var) (Flow Graph Expression -> Flow Graph Expression)
-> Flow Graph Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ do
Expression
lam <- Name -> Term -> Flow Graph Expression
toLambda Name
var Term
body
if Term -> Bool
forall {p}. p -> Bool
needsCast Term
body
then do
Type
jtype <- Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases (FunctionType -> Type
TypeFunction (FunctionType -> Type) -> FunctionType -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> FunctionType
FunctionType Type
dom Type
cod)
ReferenceType
rt <- Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType Type
jtype
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ CastExpression -> Expression
javaCastExpressionToJavaExpression (CastExpression -> Expression) -> CastExpression -> Expression
forall a b. (a -> b) -> a -> b
$
ReferenceType -> UnaryExpression -> CastExpression
javaCastExpression ReferenceType
rt (Expression -> UnaryExpression
javaExpressionToJavaUnaryExpression Expression
lam)
else Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Expression
lam
where
needsCast :: p -> Bool
needsCast p
_ = Bool
True
Function
_ -> Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ Literal -> Expression
encodeLiteral (Literal -> Expression) -> Literal -> Expression
forall a b. (a -> b) -> a -> b
$ FilePath -> Literal
LiteralString (FilePath -> Literal) -> FilePath -> Literal
forall a b. (a -> b) -> a -> b
$
FilePath
"Unimplemented function variant: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FunctionVariant -> FilePath
forall a. Show a => a -> FilePath
show (Function -> FunctionVariant
functionVariant Function
fun)
where
toLambda :: Name -> Term -> Flow Graph Expression
toLambda Name
var Term
body = Aliases
-> Term
-> (Aliases -> Term -> [BlockStatement] -> Flow Graph Expression)
-> Flow Graph Expression
forall x.
Aliases
-> Term
-> (Aliases -> Term -> [BlockStatement] -> Flow Graph x)
-> Flow Graph x
maybeLet Aliases
aliases Term
body Aliases -> Term -> [BlockStatement] -> Flow Graph Expression
forall {p}. p -> Term -> [BlockStatement] -> Flow Graph Expression
cons
where
cons :: p -> Term -> [BlockStatement] -> Flow Graph Expression
cons p
aliases' Term
term [BlockStatement]
stmts = if [BlockStatement] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [BlockStatement]
stmts
then do
Expression
jbody <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases Term
term
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ Name -> Expression -> Expression
javaLambda Name
var Expression
jbody
else do
Expression
jbody <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases Term
term
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ Name -> Block -> Expression
javaLambdaFromBlock Name
var (Block -> Expression) -> Block -> Expression
forall a b. (a -> b) -> a -> b
$ [BlockStatement] -> Block
Java.Block ([BlockStatement] -> Block) -> [BlockStatement] -> Block
forall a b. (a -> b) -> a -> b
$ [BlockStatement]
stmts
[BlockStatement] -> [BlockStatement] -> [BlockStatement]
forall a. [a] -> [a] -> [a]
++ [Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement (Maybe Expression -> Statement) -> Maybe Expression -> Statement
forall a b. (a -> b) -> a -> b
$ Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
jbody]
encodeLiteral :: Literal -> Java.Expression
encodeLiteral :: Literal -> Expression
encodeLiteral Literal
lit = Literal -> Expression
javaLiteralToJavaExpression (Literal -> Expression) -> Literal -> Expression
forall a b. (a -> b) -> a -> b
$ case Literal
lit of
LiteralBoolean Bool
b -> Bool -> Literal
javaBoolean Bool
b
LiteralFloat FloatValue
f -> FloatingPointLiteral -> Literal
Java.LiteralFloatingPoint (FloatingPointLiteral -> Literal)
-> FloatingPointLiteral -> Literal
forall a b. (a -> b) -> a -> b
$ Double -> FloatingPointLiteral
Java.FloatingPointLiteral (Double -> FloatingPointLiteral) -> Double -> FloatingPointLiteral
forall a b. (a -> b) -> a -> b
$ case FloatValue
f of
FloatValueFloat32 Float
v -> Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
v
FloatValueFloat64 Double
v -> Double
v
LiteralInteger IntegerValue
i -> case IntegerValue
i of
IntegerValueBigint Integer
v -> Integer -> Literal
integer Integer
v
IntegerValueInt8 Int8
v -> Integer -> Literal
integer (Integer -> Literal) -> Integer -> Literal
forall a b. (a -> b) -> a -> b
$ Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v
IntegerValueInt16 Int16
v -> Integer -> Literal
integer (Integer -> Literal) -> Integer -> Literal
forall a b. (a -> b) -> a -> b
$ Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
v
IntegerValueInt32 Int
v -> Integer -> Literal
integer (Integer -> Literal) -> Integer -> Literal
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
IntegerValueInt64 Int64
v -> Integer -> Literal
integer (Integer -> Literal) -> Integer -> Literal
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v
IntegerValueUint16 Int
v -> Int -> Literal
Java.LiteralCharacter (Int -> Literal) -> Int -> Literal
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
where
integer :: Integer -> Literal
integer = IntegerLiteral -> Literal
Java.LiteralInteger (IntegerLiteral -> Literal)
-> (Integer -> IntegerLiteral) -> Integer -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> IntegerLiteral
Java.IntegerLiteral
LiteralString FilePath
s -> FilePath -> Literal
javaString FilePath
s
encodeLiteralType :: LiteralType -> Flow Graph Java.Type
encodeLiteralType :: LiteralType -> Flow Graph Type
encodeLiteralType LiteralType
lt = case LiteralType
lt of
LiteralType
LiteralTypeBoolean -> FilePath -> Flow Graph Type
forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Boolean"
LiteralTypeFloat FloatType
ft -> case FloatType
ft of
FloatType
FloatTypeFloat32 -> FilePath -> Flow Graph Type
forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Float"
FloatType
FloatTypeFloat64 -> FilePath -> Flow Graph Type
forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Double"
FloatType
FloatTypeBigfloat -> FilePath -> Flow Graph Type
forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Double"
LiteralTypeInteger IntegerType
it -> case IntegerType
it of
IntegerType
IntegerTypeBigint -> Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [] (PackageName -> Maybe PackageName
forall a. a -> Maybe a
Just (PackageName -> Maybe PackageName)
-> PackageName -> Maybe PackageName
forall a b. (a -> b) -> a -> b
$ [FilePath] -> PackageName
javaPackageName [FilePath
"java", FilePath
"math"]) FilePath
"BigInteger"
IntegerType
IntegerTypeInt8 -> FilePath -> Flow Graph Type
forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Byte"
IntegerType
IntegerTypeInt16 -> FilePath -> Flow Graph Type
forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Short"
IntegerType
IntegerTypeInt32 -> FilePath -> Flow Graph Type
forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Integer"
IntegerType
IntegerTypeInt64 -> FilePath -> Flow Graph Type
forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Long"
IntegerType
IntegerTypeUint16 -> FilePath -> Flow Graph Type
forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Character"
IntegerType
_ -> FilePath -> Flow Graph Type
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Flow Graph Type) -> FilePath -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ FilePath
"unexpected integer type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IntegerType -> FilePath
forall a. Show a => a -> FilePath
show IntegerType
it
LiteralType
LiteralTypeString -> FilePath -> Flow Graph Type
forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"String"
LiteralType
_ -> FilePath -> Flow Graph Type
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Flow Graph Type) -> FilePath -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ FilePath
"unexpected literal type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ LiteralType -> FilePath
forall a. Show a => a -> FilePath
show LiteralType
lt
where
simple :: FilePath -> f Type
simple FilePath
n = Type -> f Type
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> f Type) -> Type -> f Type
forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [] Maybe PackageName
forall a. Maybe a
Nothing FilePath
n
encodeNullaryConstant :: Aliases -> Type -> Function -> Flow Graph Java.Expression
encodeNullaryConstant :: Aliases -> Type -> Function -> Flow Graph Expression
encodeNullaryConstant Aliases
aliases Type
typ Function
fun = case Function
fun of
FunctionPrimitive Name
name -> Aliases -> Bool -> Name -> [Term] -> Flow Graph Expression
functionCall Aliases
aliases Bool
True Name
name []
Function
_ -> FilePath -> FilePath -> Flow Graph Expression
forall s x. FilePath -> FilePath -> Flow s x
unexpected FilePath
"nullary function" (FilePath -> Flow Graph Expression)
-> FilePath -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ Function -> FilePath
forall a. Show a => a -> FilePath
show Function
fun
encodeTerm :: Aliases -> Term -> Flow Graph Java.Expression
encodeTerm :: Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases Term
term0 = [Map Name Term] -> Term -> Flow Graph Expression
encodeInternal [] Term
term0
where
encode :: Term -> Flow Graph Expression
encode = Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases
failAsLiteral :: FilePath -> f Expression
failAsLiteral FilePath
msg = Expression -> f Expression
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> f Expression) -> Expression -> f Expression
forall a b. (a -> b) -> a -> b
$ Literal -> Expression
encodeLiteral (Literal -> Expression) -> Literal -> Expression
forall a b. (a -> b) -> a -> b
$ FilePath -> Literal
LiteralString FilePath
msg
encodeInternal :: [Map Name Term] -> Term -> Flow Graph Expression
encodeInternal [Map Name Term]
anns Term
term = case Term
term of
TermAnnotated (AnnotatedTerm Term
term' Map Name Term
ann) -> [Map Name Term] -> Term -> Flow Graph Expression
encodeInternal (Map Name Term
annMap Name Term -> [Map Name Term] -> [Map Name Term]
forall a. a -> [a] -> [a]
:[Map Name Term]
anns) Term
term'
TermApplication Application
app -> FilePath -> Flow Graph Expression -> Flow Graph Expression
forall s a. FilePath -> Flow s a -> Flow s a
withTrace FilePath
"encode application" (Flow Graph Expression -> Flow Graph Expression)
-> Flow Graph Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ Aliases -> Application -> Flow Graph Expression
encodeApplication Aliases
aliases Application
app
TermFunction Function
f -> FilePath -> Flow Graph Expression -> Flow Graph Expression
forall s a. FilePath -> Flow s a -> Flow s a
withTrace (FilePath
"encode function (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FunctionVariant -> FilePath
forall a. Show a => a -> FilePath
show (Function -> FunctionVariant
functionVariant Function
f) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")") (Flow Graph Expression -> Flow Graph Expression)
-> Flow Graph Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ do
Type
t <- Term -> Flow Graph Type
requireTermType Term
term0
case Type -> Type
stripType Type
t of
TypeFunction (FunctionType Type
dom Type
cod) -> do
Aliases -> Type -> Type -> Function -> Flow Graph Expression
encodeFunction Aliases
aliases Type
dom Type
cod Function
f
Type
_ -> Aliases -> Type -> Function -> Flow Graph Expression
encodeNullaryConstant Aliases
aliases Type
t Function
f
TermLet Let
_ -> FilePath -> Flow Graph Expression
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Flow Graph Expression)
-> FilePath -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ FilePath
"nested let is unsupported for Java: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Term -> FilePath
showTerm Term
term
TermList [Term]
els -> do
[Expression]
jels <- (Term -> Flow Graph Expression)
-> [Term] -> Flow Graph [Expression]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Term -> Flow Graph Expression
encode [Term]
els
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$
Identifier -> Identifier -> [Expression] -> MethodInvocation
methodInvocationStatic (FilePath -> Identifier
Java.Identifier FilePath
"java.util.Arrays") (FilePath -> Identifier
Java.Identifier FilePath
"asList") [Expression]
jels
TermLiteral Literal
l -> Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ Literal -> Expression
encodeLiteral Literal
l
TermOptional Maybe Term
mt -> case Maybe Term
mt of
Maybe Term
Nothing -> Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$
Identifier -> Identifier -> [Expression] -> MethodInvocation
methodInvocationStatic (FilePath -> Identifier
Java.Identifier FilePath
"hydra.util.Opt") (FilePath -> Identifier
Java.Identifier FilePath
"empty") []
Just Term
term1 -> do
Expression
expr <- Term -> Flow Graph Expression
encode Term
term1
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$
Identifier -> Identifier -> [Expression] -> MethodInvocation
methodInvocationStatic (FilePath -> Identifier
Java.Identifier FilePath
"hydra.util.Opt") (FilePath -> Identifier
Java.Identifier FilePath
"of") [Expression
expr]
TermProduct [Term]
terms -> do
[Expression]
jterms <- (Term -> Flow Graph Expression)
-> [Term] -> Flow Graph [Expression]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Term -> Flow Graph Expression
encode [Term]
terms
let tupleTypeName :: FilePath
tupleTypeName = FilePath
"hydra.util.Tuple.Tuple" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([Term] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term]
terms)
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName (FilePath -> Identifier
Java.Identifier FilePath
tupleTypeName) Maybe TypeArgumentsOrDiamond
forall a. Maybe a
Nothing) [Expression]
jterms Maybe ClassBody
forall a. Maybe a
Nothing
TermRecord (Record Name
name [Field]
fields) -> do
[Expression]
fieldExprs <- (Term -> Flow Graph Expression)
-> [Term] -> Flow Graph [Expression]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Term -> Flow Graph Expression
encode (Field -> Term
fieldTerm (Field -> Term) -> [Field] -> [Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field]
fields)
let consId :: Identifier
consId = Aliases -> Name -> Identifier
nameToJavaName Aliases
aliases Name
name
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName Identifier
consId Maybe TypeArgumentsOrDiamond
forall a. Maybe a
Nothing) [Expression]
fieldExprs Maybe ClassBody
forall a. Maybe a
Nothing
TermSet Set Term
s -> do
[Expression]
jels <- (Term -> Flow Graph Expression)
-> [Term] -> Flow Graph [Expression]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Term -> Flow Graph Expression
encode ([Term] -> Flow Graph [Expression])
-> [Term] -> Flow Graph [Expression]
forall a b. (a -> b) -> a -> b
$ Set Term -> [Term]
forall a. Set a -> [a]
S.toList Set Term
s
let prim :: Primary
prim = MethodInvocation -> Primary
javaMethodInvocationToJavaPrimary (MethodInvocation -> Primary) -> MethodInvocation -> Primary
forall a b. (a -> b) -> a -> b
$
Identifier -> Identifier -> [Expression] -> MethodInvocation
methodInvocationStatic (FilePath -> Identifier
Java.Identifier FilePath
"java.util.Stream") (FilePath -> Identifier
Java.Identifier FilePath
"of") [Expression]
jels
let coll :: Expression
coll = MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$
Identifier -> Identifier -> [Expression] -> MethodInvocation
methodInvocationStatic (FilePath -> Identifier
Java.Identifier FilePath
"java.util.stream.Collectors") (FilePath -> Identifier
Java.Identifier FilePath
"toSet") []
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$
Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a. a -> Maybe a
Just (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary))
-> Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a b. (a -> b) -> a -> b
$ Primary -> Either ExpressionName Primary
forall a b. b -> Either a b
Right Primary
prim) (FilePath -> Identifier
Java.Identifier FilePath
"collect") [Expression
coll]
TermTyped (TypedTerm Term
term1 Type
_) -> [Map Name Term] -> Term -> Flow Graph Expression
encodeInternal [Map Name Term]
anns Term
term1
TermUnion (Injection Name
name (Field (Name FilePath
fname) Term
v)) -> do
let (Java.Identifier FilePath
typeId) = Aliases -> Name -> Identifier
nameToJavaName Aliases
aliases Name
name
let consId :: Identifier
consId = FilePath -> Identifier
Java.Identifier (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ FilePath
typeId FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
sanitizeJavaName (FilePath -> FilePath
capitalize FilePath
fname)
[Expression]
args <- if Term -> Bool
isUnitTerm Term
v
then [Expression] -> Flow Graph [Expression]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
Expression
ex <- Term -> Flow Graph Expression
encode Term
v
[Expression] -> Flow Graph [Expression]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return [Expression
ex]
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName Identifier
consId Maybe TypeArgumentsOrDiamond
forall a. Maybe a
Nothing) [Expression]
args Maybe ClassBody
forall a. Maybe a
Nothing
TermVariable Name
name -> Aliases -> Name -> Flow Graph Expression
encodeVariable Aliases
aliases Name
name
TermWrap (WrappedTerm Name
tname Term
arg) -> do
Expression
jarg <- Term -> Flow Graph Expression
encode Term
arg
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName (Aliases -> Name -> Identifier
nameToJavaName Aliases
aliases Name
tname) Maybe TypeArgumentsOrDiamond
forall a. Maybe a
Nothing) [Expression
jarg] Maybe ClassBody
forall a. Maybe a
Nothing
Term
_ -> FilePath -> Flow Graph Expression
forall {f :: * -> *}. Applicative f => FilePath -> f Expression
failAsLiteral (FilePath -> Flow Graph Expression)
-> FilePath -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ FilePath
"Unimplemented term variant: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TermVariant -> FilePath
forall a. Show a => a -> FilePath
show (Term -> TermVariant
termVariant Term
term)
encodeType :: Aliases -> Type -> Flow Graph Java.Type
encodeType :: Aliases -> Type -> Flow Graph Type
encodeType Aliases
aliases Type
t = case Type -> Type
stripType Type
t of
TypeApplication (ApplicationType Type
lhs Type
rhs) -> do
Type
jlhs <- Type -> Flow Graph Type
encode Type
lhs
ReferenceType
jrhs <- Type -> Flow Graph Type
encode Type
rhs Flow Graph Type
-> (Type -> Flow Graph ReferenceType) -> Flow Graph ReferenceType
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType
ReferenceType -> Type -> Flow Graph Type
addJavaTypeParameter ReferenceType
jrhs Type
jlhs
TypeFunction (FunctionType Type
dom Type
cod) -> do
ReferenceType
jdom <- Type -> Flow Graph Type
encode Type
dom Flow Graph Type
-> (Type -> Flow Graph ReferenceType) -> Flow Graph ReferenceType
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType
ReferenceType
jcod <- Type -> Flow Graph Type
encode Type
cod Flow Graph Type
-> (Type -> Flow Graph ReferenceType) -> Flow Graph ReferenceType
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType
Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType
jdom, ReferenceType
jcod] Maybe PackageName
javaUtilFunctionPackageName FilePath
"Function"
TypeLambda (LambdaType (Name FilePath
v) Type
body) -> do
Type
jbody <- Type -> Flow Graph Type
encode Type
body
ReferenceType -> Type -> Flow Graph Type
addJavaTypeParameter (FilePath -> ReferenceType
javaTypeVariable FilePath
v) Type
jbody
TypeList Type
et -> do
Type
jet <- Type -> Flow Graph Type
encode Type
et
if Bool
listsAsArrays
then Type -> Flow Graph Type
toJavaArrayType Type
jet
else do
ReferenceType
rt <- Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType Type
jet
Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType
rt] Maybe PackageName
javaUtilPackageName FilePath
"List"
TypeLiteral LiteralType
lt -> LiteralType -> Flow Graph Type
encodeLiteralType LiteralType
lt
TypeMap (MapType Type
kt Type
vt) -> do
ReferenceType
jkt <- Type -> Flow Graph Type
encode Type
kt Flow Graph Type
-> (Type -> Flow Graph ReferenceType) -> Flow Graph ReferenceType
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType
ReferenceType
jvt <- Type -> Flow Graph Type
encode Type
vt Flow Graph Type
-> (Type -> Flow Graph ReferenceType) -> Flow Graph ReferenceType
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType
Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType
jkt, ReferenceType
jvt] Maybe PackageName
javaUtilPackageName FilePath
"Map"
TypeProduct [Type]
types -> case [Type]
types of
[] -> Flow Graph Type
unit
[Type]
_ -> do
[ReferenceType]
jtypes <- (Type -> Flow Graph Type) -> [Type] -> Flow Graph [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Type -> Flow Graph Type
encode [Type]
types Flow Graph [Type]
-> ([Type] -> Flow Graph [ReferenceType])
-> Flow Graph [ReferenceType]
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Type -> Flow Graph ReferenceType)
-> [Type] -> Flow Graph [ReferenceType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType
Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType]
jtypes Maybe PackageName
hydraUtilPackageName (FilePath -> Type) -> FilePath -> Type
forall a b. (a -> b) -> a -> b
$ FilePath
"Tuple.Tuple" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ [Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
types)
TypeRecord (RowType Name
_Unit []) -> Flow Graph Type
unit
TypeRecord (RowType Name
name [FieldType]
_) -> Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$
ReferenceType -> Type
Java.TypeReference (ReferenceType -> Type) -> ReferenceType -> Type
forall a b. (a -> b) -> a -> b
$ Aliases
-> Bool
-> [TypeArgument]
-> Name
-> Maybe FilePath
-> ReferenceType
nameToJavaReferenceType Aliases
aliases Bool
True (Type -> [TypeArgument]
javaTypeArgumentsForType Type
t) Name
name Maybe FilePath
forall a. Maybe a
Nothing
TypeOptional Type
ot -> do
ReferenceType
jot <- Type -> Flow Graph Type
encode Type
ot Flow Graph Type
-> (Type -> Flow Graph ReferenceType) -> Flow Graph ReferenceType
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType
Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType
jot] Maybe PackageName
hydraUtilPackageName FilePath
"Opt"
TypeSet Type
st -> do
ReferenceType
jst <- Type -> Flow Graph Type
encode Type
st Flow Graph Type
-> (Type -> Flow Graph ReferenceType) -> Flow Graph ReferenceType
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType
Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType
jst] Maybe PackageName
javaUtilPackageName FilePath
"Set"
TypeUnion (RowType Name
name [FieldType]
_) -> Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$
ReferenceType -> Type
Java.TypeReference (ReferenceType -> Type) -> ReferenceType -> Type
forall a b. (a -> b) -> a -> b
$ Aliases
-> Bool
-> [TypeArgument]
-> Name
-> Maybe FilePath
-> ReferenceType
nameToJavaReferenceType Aliases
aliases Bool
True (Type -> [TypeArgument]
javaTypeArgumentsForType Type
t) Name
name Maybe FilePath
forall a. Maybe a
Nothing
TypeVariable Name
name -> Name -> Flow Graph Type
forall {f :: * -> *}. Applicative f => Name -> f Type
forReference Name
name
TypeWrap (WrappedType Name
name Type
_) -> Name -> Flow Graph Type
forall {f :: * -> *}. Applicative f => Name -> f Type
forReference Name
name
Type
_ -> FilePath -> Flow Graph Type
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Flow Graph Type) -> FilePath -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ FilePath
"can't encode unsupported type in Java: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
t
where
forReference :: Name -> f Type
forReference Name
name = Type -> f Type
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> f Type) -> Type -> f Type
forall a b. (a -> b) -> a -> b
$ if Name -> Bool
isLambdaBoundVariable Name
name
then Name -> Type
variableReference Name
name
else Name -> Type
nameReference Name
name
nameReference :: Name -> Type
nameReference Name
name = ReferenceType -> Type
Java.TypeReference (ReferenceType -> Type) -> ReferenceType -> Type
forall a b. (a -> b) -> a -> b
$ Aliases
-> Bool
-> [TypeArgument]
-> Name
-> Maybe FilePath
-> ReferenceType
nameToJavaReferenceType Aliases
aliases Bool
True [] Name
name Maybe FilePath
forall a. Maybe a
Nothing
variableReference :: Name -> Type
variableReference Name
name = ReferenceType -> Type
Java.TypeReference (ReferenceType -> Type) -> ReferenceType -> Type
forall a b. (a -> b) -> a -> b
$ FilePath -> ReferenceType
javaTypeVariable (FilePath -> ReferenceType) -> FilePath -> ReferenceType
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
unName Name
name
encode :: Type -> Flow Graph Type
encode = Aliases -> Type -> Flow Graph Type
encodeType Aliases
aliases
unit :: Flow Graph Type
unit = Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [] Maybe PackageName
javaLangPackageName FilePath
"Void"
encodeVariable :: Aliases -> Name -> Flow Graph Java.Expression
encodeVariable :: Aliases -> Name -> Flow Graph Expression
encodeVariable Aliases
aliases Name
name = if Aliases -> Name -> Bool
isRecursiveVariable Aliases
aliases Name
name
then Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$
Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a. a -> Maybe a
Just (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary))
-> Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a b. (a -> b) -> a -> b
$ ExpressionName -> Either ExpressionName Primary
forall a b. a -> Either a b
Left (ExpressionName -> Either ExpressionName Primary)
-> ExpressionName -> Either ExpressionName Primary
forall a b. (a -> b) -> a -> b
$ Maybe AmbiguousName -> Identifier -> ExpressionName
Java.ExpressionName Maybe AmbiguousName
forall a. Maybe a
Nothing Identifier
jid) (FilePath -> Identifier
Java.Identifier FilePath
getMethodName) []
else do
JavaSymbolClass
cls <- Name -> Flow Graph JavaSymbolClass
classifyDataReference Name
name
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ case JavaSymbolClass
cls of
JavaSymbolClass
JavaSymbolLocalVariable -> Identifier -> Expression
javaIdentifierToJavaExpression (Identifier -> Expression) -> Identifier -> Expression
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Aliases -> Name -> Identifier
elementJavaIdentifier Bool
False Bool
False Aliases
aliases Name
name
JavaSymbolClass
JavaSymbolClassConstant -> Identifier -> Expression
javaIdentifierToJavaExpression (Identifier -> Expression) -> Identifier -> Expression
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Aliases -> Name -> Identifier
elementJavaIdentifier Bool
False Bool
False Aliases
aliases Name
name
JavaSymbolClass
JavaSymbolClassNullaryFunction -> Identifier -> Expression
javaIdentifierToJavaExpression (Identifier -> Expression) -> Identifier -> Expression
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Aliases -> Name -> Identifier
elementJavaIdentifier Bool
False Bool
True Aliases
aliases Name
name
JavaSymbolClass
JavaSymbolClassUnaryFunction -> Identifier -> Expression
javaIdentifierToJavaExpression (Identifier -> Expression) -> Identifier -> Expression
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Aliases -> Name -> Identifier
elementJavaIdentifier Bool
False Bool
True Aliases
aliases Name
name
where
jid :: Identifier
jid = FilePath -> Identifier
javaIdentifier (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
unName Name
name
fieldToNullCheckStatement :: FieldType -> Java.BlockStatement
fieldToNullCheckStatement :: FieldType -> BlockStatement
fieldToNullCheckStatement FieldType
field = Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Statement
javaMethodInvocationToJavaStatement (MethodInvocation -> Statement) -> MethodInvocation -> Statement
forall a b. (a -> b) -> a -> b
$ MethodInvocation_Header -> [Expression] -> MethodInvocation
Java.MethodInvocation MethodInvocation_Header
header [Expression
arg]
where
arg :: Expression
arg = Identifier -> Expression
javaIdentifierToJavaExpression (Identifier -> Expression) -> Identifier -> Expression
forall a b. (a -> b) -> a -> b
$ Name -> Identifier
fieldNameToJavaIdentifier (Name -> Identifier) -> Name -> Identifier
forall a b. (a -> b) -> a -> b
$ FieldType -> Name
fieldTypeName FieldType
field
header :: MethodInvocation_Header
header = MethodName -> MethodInvocation_Header
Java.MethodInvocation_HeaderSimple (MethodName -> MethodInvocation_Header)
-> MethodName -> MethodInvocation_Header
forall a b. (a -> b) -> a -> b
$ Identifier -> MethodName
Java.MethodName (Identifier -> MethodName) -> Identifier -> MethodName
forall a b. (a -> b) -> a -> b
$
FilePath -> Identifier
Java.Identifier FilePath
"java.util.Objects.requireNonNull"
fieldTypeToFormalParam :: Aliases -> FieldType -> Flow Graph FormalParameter
fieldTypeToFormalParam Aliases
aliases (FieldType Name
fname Type
ft) = do
Type
jt <- Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliases Type
ft
FormalParameter -> Flow Graph FormalParameter
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (FormalParameter -> Flow Graph FormalParameter)
-> FormalParameter -> Flow Graph FormalParameter
forall a b. (a -> b) -> a -> b
$ Type -> Name -> FormalParameter
javaTypeToJavaFormalParameter Type
jt Name
fname
functionCall :: Aliases -> Bool -> Name -> [Term] -> Flow Graph Java.Expression
functionCall :: Aliases -> Bool -> Name -> [Term] -> Flow Graph Expression
functionCall Aliases
aliases Bool
isPrim Name
name [Term]
args = do
[Expression]
jargs <- (Term -> Flow Graph Expression)
-> [Term] -> Flow Graph [Expression]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases) [Term]
args
if Name -> Bool
isLocalVariable Name
name
then do
Primary
prim <- Expression -> Primary
javaExpressionToJavaPrimary (Expression -> Primary)
-> Flow Graph Expression -> Flow Graph Primary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Aliases -> Name -> Flow Graph Expression
encodeVariable Aliases
aliases Name
name
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$
Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a. a -> Maybe a
Just (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary))
-> Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a b. (a -> b) -> a -> b
$ Primary -> Either ExpressionName Primary
forall a b. b -> Either a b
Right Primary
prim) (FilePath -> Identifier
Java.Identifier FilePath
applyMethodName) [Expression]
jargs
else do
let header :: MethodInvocation_Header
header = MethodName -> MethodInvocation_Header
Java.MethodInvocation_HeaderSimple (MethodName -> MethodInvocation_Header)
-> MethodName -> MethodInvocation_Header
forall a b. (a -> b) -> a -> b
$ Identifier -> MethodName
Java.MethodName (Identifier -> MethodName) -> Identifier -> MethodName
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Aliases -> Name -> Identifier
elementJavaIdentifier Bool
isPrim Bool
False Aliases
aliases Name
name
Expression -> Flow Graph Expression
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Flow Graph Expression)
-> Expression -> Flow Graph Expression
forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression (MethodInvocation -> Expression) -> MethodInvocation -> Expression
forall a b. (a -> b) -> a -> b
$ MethodInvocation_Header -> [Expression] -> MethodInvocation
Java.MethodInvocation MethodInvocation_Header
header [Expression]
jargs
getCodomain :: M.Map Name Term -> Flow Graph Type
getCodomain :: Map Name Term -> Flow Graph Type
getCodomain Map Name Term
ann = FunctionType -> Type
functionTypeCodomain (FunctionType -> Type)
-> Flow Graph FunctionType -> Flow Graph Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Term -> Flow Graph FunctionType
getFunctionType Map Name Term
ann
getFunctionType :: M.Map Name Term -> Flow Graph FunctionType
getFunctionType :: Map Name Term -> Flow Graph FunctionType
getFunctionType Map Name Term
ann = do
Maybe Type
mt <- Map Name Term -> Flow Graph (Maybe Type)
getType Map Name Term
ann
case Maybe Type
mt of
Maybe Type
Nothing -> FilePath -> Flow Graph FunctionType
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"type annotation is required for function and elimination terms in Java"
Just Type
t -> case Type
t of
TypeFunction FunctionType
ft -> FunctionType -> Flow Graph FunctionType
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionType
ft
Type
_ -> FilePath -> FilePath -> Flow Graph FunctionType
forall s x. FilePath -> FilePath -> Flow s x
unexpected FilePath
"function type (3)" (FilePath -> Flow Graph FunctionType)
-> FilePath -> Flow Graph FunctionType
forall a b. (a -> b) -> a -> b
$ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
t
innerClassRef :: Aliases -> Name -> String -> Java.Identifier
innerClassRef :: Aliases -> Name -> FilePath -> Identifier
innerClassRef Aliases
aliases Name
name FilePath
local = FilePath -> Identifier
Java.Identifier (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ FilePath
id FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
local
where
Java.Identifier FilePath
id = Aliases -> Name -> Identifier
nameToJavaName Aliases
aliases Name
name
interfaceTypes :: Bool -> [Java.InterfaceType]
interfaceTypes :: Bool -> [InterfaceType]
interfaceTypes Bool
isSer = if Bool
isSer then [InterfaceType
javaSerializableType] else []
where
javaSerializableType :: InterfaceType
javaSerializableType = ClassType -> InterfaceType
Java.InterfaceType (ClassType -> InterfaceType) -> ClassType -> InterfaceType
forall a b. (a -> b) -> a -> b
$
[Annotation]
-> ClassTypeQualifier
-> TypeIdentifier
-> [TypeArgument]
-> ClassType
Java.ClassType [] ClassTypeQualifier
Java.ClassTypeQualifierNone (FilePath -> TypeIdentifier
javaTypeIdentifier FilePath
"Serializable") []
isLambdaBoundVariable :: Name -> Bool
isLambdaBoundVariable :: Name -> Bool
isLambdaBoundVariable (Name FilePath
v) = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length FilePath
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4
isLocalVariable :: Name -> Bool
isLocalVariable :: Name -> Bool
isLocalVariable Name
name = Maybe Namespace -> Bool
forall a. Maybe a -> Bool
Y.isNothing (Maybe Namespace -> Bool) -> Maybe Namespace -> Bool
forall a b. (a -> b) -> a -> b
$ QualifiedName -> Maybe Namespace
qualifiedNameNamespace (QualifiedName -> Maybe Namespace)
-> QualifiedName -> Maybe Namespace
forall a b. (a -> b) -> a -> b
$ Name -> QualifiedName
qualifyNameEager Name
name
isRecursiveVariable :: Aliases -> Name -> Bool
isRecursiveVariable :: Aliases -> Name -> Bool
isRecursiveVariable Aliases
aliases Name
name = Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Name
name (Aliases -> Set Name
aliasesRecursiveVars Aliases
aliases)
javaTypeArgumentsForNamedType :: Name -> Flow Graph [Java.TypeArgument]
javaTypeArgumentsForNamedType :: Name -> Flow Graph [TypeArgument]
javaTypeArgumentsForNamedType Name
tname = do
[TypeParameter]
params <- Type -> [TypeParameter]
javaTypeParametersForType (Type -> [TypeParameter])
-> Flow Graph Type -> Flow Graph [TypeParameter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Flow Graph Type
requireType Name
tname
[TypeArgument] -> Flow Graph [TypeArgument]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TypeArgument] -> Flow Graph [TypeArgument])
-> [TypeArgument] -> Flow Graph [TypeArgument]
forall a b. (a -> b) -> a -> b
$ TypeParameter -> TypeArgument
typeParameterToTypeArgument (TypeParameter -> TypeArgument)
-> [TypeParameter] -> [TypeArgument]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeParameter]
params
javaTypeArgumentsForType :: Type -> [Java.TypeArgument]
javaTypeArgumentsForType :: Type -> [TypeArgument]
javaTypeArgumentsForType Type
typ = [TypeArgument] -> [TypeArgument]
forall a. [a] -> [a]
L.reverse (TypeParameter -> TypeArgument
typeParameterToTypeArgument (TypeParameter -> TypeArgument)
-> [TypeParameter] -> [TypeArgument]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> [TypeParameter]
javaTypeParametersForType Type
typ)
javaTypeParametersForType :: Type -> [Java.TypeParameter]
javaTypeParametersForType :: Type -> [TypeParameter]
javaTypeParametersForType Type
typ = Name -> TypeParameter
toParam (Name -> TypeParameter) -> [Name] -> [TypeParameter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
vars
where
toParam :: Name -> TypeParameter
toParam (Name FilePath
v) = [TypeParameterModifier]
-> TypeIdentifier -> Maybe TypeBound -> TypeParameter
Java.TypeParameter [] (FilePath -> TypeIdentifier
javaTypeIdentifier (FilePath -> TypeIdentifier) -> FilePath -> TypeIdentifier
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
capitalize FilePath
v) Maybe TypeBound
forall a. Maybe a
Nothing
vars :: [Name]
vars = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
L.nub ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ Type -> [Name]
boundVars Type
typ [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
freeVars
boundVars :: Type -> [Name]
boundVars Type
t = case Type -> Type
stripType Type
t of
TypeLambda (LambdaType Name
v Type
body) -> Name
vName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:(Type -> [Name]
boundVars Type
body)
Type
_ -> []
freeVars :: [Name]
freeVars = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
L.filter Name -> Bool
isLambdaBoundVariable ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ Set Name -> [Name]
forall a. Set a -> [a]
S.toList (Set Name -> [Name]) -> Set Name -> [Name]
forall a b. (a -> b) -> a -> b
$ Type -> Set Name
freeVariablesInType Type
typ
maybeLet :: Aliases -> Term -> (Aliases -> Term -> [Java.BlockStatement] -> Flow Graph x) -> Flow Graph x
maybeLet :: forall x.
Aliases
-> Term
-> (Aliases -> Term -> [BlockStatement] -> Flow Graph x)
-> Flow Graph x
maybeLet Aliases
aliases Term
term Aliases -> Term -> [BlockStatement] -> Flow Graph x
cons = Maybe Type -> [Map Name Term] -> Term -> Flow Graph x
helper Maybe Type
forall a. Maybe a
Nothing [] Term
term
where
helper :: Maybe Type -> [Map Name Term] -> Term -> Flow Graph x
helper Maybe Type
mtyp [Map Name Term]
anns Term
term = case Term -> Term
flattenLetTerms Term
term of
TermAnnotated (AnnotatedTerm Term
term' Map Name Term
ann) -> Maybe Type -> [Map Name Term] -> Term -> Flow Graph x
helper Maybe Type
mtyp (Map Name Term
annMap Name Term -> [Map Name Term] -> [Map Name Term]
forall a. a -> [a] -> [a]
:[Map Name Term]
anns) Term
term'
TermTyped (TypedTerm Term
term' Type
typ) -> Maybe Type -> [Map Name Term] -> Term -> Flow Graph x
helper (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
typ) [Map Name Term]
anns Term
term'
TermLet (Let [LetBinding]
bindings Term
env) -> do
[BlockStatement]
stmts <- [[BlockStatement]] -> [BlockStatement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat ([[BlockStatement]] -> [BlockStatement])
-> Flow Graph [[BlockStatement]] -> Flow Graph [BlockStatement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Name] -> Flow Graph [BlockStatement])
-> [[Name]] -> Flow Graph [[BlockStatement]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM [Name] -> Flow Graph [BlockStatement]
toDeclStatements [[Name]]
sorted
Aliases
-> Term
-> (Aliases -> Term -> [BlockStatement] -> Flow Graph x)
-> Flow Graph x
forall x.
Aliases
-> Term
-> (Aliases -> Term -> [BlockStatement] -> Flow Graph x)
-> Flow Graph x
maybeLet Aliases
aliasesWithRecursive Term
env ((Aliases -> Term -> [BlockStatement] -> Flow Graph x)
-> Flow Graph x)
-> (Aliases -> Term -> [BlockStatement] -> Flow Graph x)
-> Flow Graph x
forall a b. (a -> b) -> a -> b
$ \Aliases
aliases' Term
tm [BlockStatement]
stmts' -> Aliases -> Term -> [BlockStatement] -> Flow Graph x
cons Aliases
aliases' (Maybe Type -> [Map Name Term] -> Term -> Term
reannotate Maybe Type
mtyp [Map Name Term]
anns Term
tm) ([BlockStatement]
stmts [BlockStatement] -> [BlockStatement] -> [BlockStatement]
forall a. [a] -> [a] -> [a]
++ [BlockStatement]
stmts')
where
aliasesWithRecursive :: Aliases
aliasesWithRecursive = Aliases
aliases { aliasesRecursiveVars = recursiveVars }
toDeclStatements :: [Name] -> Flow Graph [BlockStatement]
toDeclStatements [Name]
names = do
[BlockStatement]
inits <- [Maybe BlockStatement] -> [BlockStatement]
forall a. [Maybe a] -> [a]
Y.catMaybes ([Maybe BlockStatement] -> [BlockStatement])
-> Flow Graph [Maybe BlockStatement] -> Flow Graph [BlockStatement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> Flow Graph (Maybe BlockStatement))
-> [Name] -> Flow Graph [Maybe BlockStatement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Name -> Flow Graph (Maybe BlockStatement)
toDeclInit [Name]
names
[BlockStatement]
impls <- (Name -> Flow Graph BlockStatement)
-> [Name] -> Flow Graph [BlockStatement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Name -> Flow Graph BlockStatement
toDeclStatement [Name]
names
[BlockStatement] -> Flow Graph [BlockStatement]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return ([BlockStatement] -> Flow Graph [BlockStatement])
-> [BlockStatement] -> Flow Graph [BlockStatement]
forall a b. (a -> b) -> a -> b
$ [BlockStatement]
inits [BlockStatement] -> [BlockStatement] -> [BlockStatement]
forall a. [a] -> [a] -> [a]
++ [BlockStatement]
impls
toDeclInit :: Name -> Flow Graph (Maybe BlockStatement)
toDeclInit Name
name = if Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Name
name Set Name
recursiveVars
then do
let value :: Term
value = LetBinding -> Term
letBindingTerm (LetBinding -> Term) -> LetBinding -> Term
forall a b. (a -> b) -> a -> b
$ [LetBinding] -> LetBinding
forall a. HasCallStack => [a] -> a
L.head ([LetBinding] -> LetBinding) -> [LetBinding] -> LetBinding
forall a b. (a -> b) -> a -> b
$ (LetBinding -> Bool) -> [LetBinding] -> [LetBinding]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\LetBinding
b -> LetBinding -> Name
letBindingName LetBinding
b Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name) [LetBinding]
bindings
Type
typ <- Term -> Flow Graph Type
requireTermType Term
value
Type
jtype <- Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliasesWithRecursive Type
typ
let id :: Identifier
id = Name -> Identifier
variableToJavaIdentifier Name
name
let pkg :: PackageName
pkg = [FilePath] -> PackageName
javaPackageName [FilePath
"java", FilePath
"util", FilePath
"concurrent", FilePath
"atomic"]
let arid :: Identifier
arid = FilePath -> Identifier
Java.Identifier FilePath
"java.util.concurrent.atomic.AtomicReference"
let aid :: AnnotatedIdentifier
aid = [Annotation] -> Identifier -> AnnotatedIdentifier
Java.AnnotatedIdentifier [] Identifier
arid
ReferenceType
rt <- Type -> Flow Graph ReferenceType
javaTypeToJavaReferenceType Type
jtype
let targs :: TypeArgumentsOrDiamond
targs = [TypeArgument] -> TypeArgumentsOrDiamond
typeArgsOrDiamond [ReferenceType -> TypeArgument
Java.TypeArgumentReference ReferenceType
rt]
let ci :: ClassOrInterfaceTypeToInstantiate
ci = [AnnotatedIdentifier]
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
Java.ClassOrInterfaceTypeToInstantiate [AnnotatedIdentifier
aid] (TypeArgumentsOrDiamond -> Maybe TypeArgumentsOrDiamond
forall a. a -> Maybe a
Just TypeArgumentsOrDiamond
targs)
let body :: Expression
body = ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall ClassOrInterfaceTypeToInstantiate
ci [] Maybe ClassBody
forall a. Maybe a
Nothing
let artype :: Type
artype = [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType
rt] (PackageName -> Maybe PackageName
forall a. a -> Maybe a
Just PackageName
pkg) FilePath
"AtomicReference"
Maybe BlockStatement -> Flow Graph (Maybe BlockStatement)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BlockStatement -> Flow Graph (Maybe BlockStatement))
-> Maybe BlockStatement -> Flow Graph (Maybe BlockStatement)
forall a b. (a -> b) -> a -> b
$ BlockStatement -> Maybe BlockStatement
forall a. a -> Maybe a
Just (BlockStatement -> Maybe BlockStatement)
-> BlockStatement -> Maybe BlockStatement
forall a b. (a -> b) -> a -> b
$ Aliases -> Type -> Identifier -> Expression -> BlockStatement
variableDeclarationStatement Aliases
aliasesWithRecursive Type
artype Identifier
id Expression
body
else Maybe BlockStatement -> Flow Graph (Maybe BlockStatement)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BlockStatement
forall a. Maybe a
Nothing
toDeclStatement :: Name -> Flow Graph BlockStatement
toDeclStatement Name
name = do
let value :: Term
value = LetBinding -> Term
letBindingTerm (LetBinding -> Term) -> LetBinding -> Term
forall a b. (a -> b) -> a -> b
$ [LetBinding] -> LetBinding
forall a. HasCallStack => [a] -> a
L.head ([LetBinding] -> LetBinding) -> [LetBinding] -> LetBinding
forall a b. (a -> b) -> a -> b
$ (LetBinding -> Bool) -> [LetBinding] -> [LetBinding]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\LetBinding
b -> LetBinding -> Name
letBindingName LetBinding
b Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name) [LetBinding]
bindings
Type
typ <- Term -> Flow Graph Type
requireTermType Term
value
Type
jtype <- Aliases -> Type -> Flow Graph Type
adaptTypeToJavaAndEncode Aliases
aliasesWithRecursive Type
typ
let id :: Identifier
id = Name -> Identifier
variableToJavaIdentifier Name
name
Expression
rhs <- Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliasesWithRecursive Term
value
BlockStatement -> Flow Graph BlockStatement
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockStatement -> Flow Graph BlockStatement)
-> BlockStatement -> Flow Graph BlockStatement
forall a b. (a -> b) -> a -> b
$ if Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Name
name Set Name
recursiveVars
then Statement -> BlockStatement
Java.BlockStatementStatement (Statement -> BlockStatement) -> Statement -> BlockStatement
forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Statement
javaMethodInvocationToJavaStatement (MethodInvocation -> Statement) -> MethodInvocation -> Statement
forall a b. (a -> b) -> a -> b
$
Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a. a -> Maybe a
Just (Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary))
-> Either ExpressionName Primary
-> Maybe (Either ExpressionName Primary)
forall a b. (a -> b) -> a -> b
$ ExpressionName -> Either ExpressionName Primary
forall a b. a -> Either a b
Left (ExpressionName -> Either ExpressionName Primary)
-> ExpressionName -> Either ExpressionName Primary
forall a b. (a -> b) -> a -> b
$ Maybe AmbiguousName -> Identifier -> ExpressionName
Java.ExpressionName Maybe AmbiguousName
forall a. Maybe a
Nothing Identifier
id) (FilePath -> Identifier
Java.Identifier FilePath
setMethodName) [Expression
rhs]
else Aliases -> Type -> Identifier -> Expression -> BlockStatement
variableDeclarationStatement Aliases
aliasesWithRecursive Type
jtype Identifier
id Expression
rhs
bindingVars :: Set Name
bindingVars = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList (LetBinding -> Name
letBindingName (LetBinding -> Name) -> [LetBinding] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LetBinding]
bindings)
recursiveVars :: Set Name
recursiveVars = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList ([Name] -> Set Name) -> [Name] -> Set Name
forall a b. (a -> b) -> a -> b
$ [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat ([Name] -> [Name]
ifRec ([Name] -> [Name]) -> [[Name]] -> [[Name]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Name]]
sorted)
where
ifRec :: [Name] -> [Name]
ifRec [Name]
names = case [Name]
names of
[Name
name] -> case Name -> Map Name (Set Name) -> Maybe (Set Name)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name Map Name (Set Name)
allDeps of
Maybe (Set Name)
Nothing -> []
Just Set Name
deps -> if Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Name
name Set Name
deps
then [Name
name]
else []
[Name]
_ -> [Name]
names
allDeps :: Map Name (Set Name)
allDeps = [(Name, Set Name)] -> Map Name (Set Name)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (LetBinding -> (Name, Set Name)
toDeps (LetBinding -> (Name, Set Name))
-> [LetBinding] -> [(Name, Set Name)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LetBinding]
bindings)
where
toDeps :: LetBinding -> (Name, Set Name)
toDeps (LetBinding Name
key Term
value Maybe TypeScheme
_) = (Name
key, (Name -> Bool) -> Set Name -> Set Name
forall a. (a -> Bool) -> Set a -> Set a
S.filter (\Name
n -> Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Name
n Set Name
bindingVars) (Set Name -> Set Name) -> Set Name -> Set Name
forall a b. (a -> b) -> a -> b
$ Term -> Set Name
freeVariablesInTerm Term
value)
sorted :: [[Name]]
sorted = [(Name, [Name])] -> [[Name]]
forall a. Ord a => [(a, [a])] -> [[a]]
topologicalSortComponents ((Name, Set Name) -> (Name, [Name])
forall {a} {a}. (a, Set a) -> (a, [a])
toDeps ((Name, Set Name) -> (Name, [Name]))
-> [(Name, Set Name)] -> [(Name, [Name])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name (Set Name) -> [(Name, Set Name)]
forall k a. Map k a -> [(k, a)]
M.toList Map Name (Set Name)
allDeps)
where
toDeps :: (a, Set a) -> (a, [a])
toDeps (a
key, Set a
deps) = (a
key, Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
deps)
Term
_ -> Aliases -> Term -> [BlockStatement] -> Flow Graph x
cons Aliases
aliases (Maybe Type -> [Map Name Term] -> Term -> Term
reannotate Maybe Type
mtyp [Map Name Term]
anns Term
term) []
moduleToJavaCompilationUnit :: Module -> Flow Graph (M.Map Name Java.CompilationUnit)
moduleToJavaCompilationUnit :: Module -> Flow Graph (Map Name CompilationUnit)
moduleToJavaCompilationUnit Module
mod = Language
-> (Term -> Flow Graph Expression)
-> (Module
-> Map Type (Coder Graph Graph Term Expression)
-> [(Element, TypedTerm)]
-> Flow Graph (Map Name CompilationUnit))
-> Module
-> Flow Graph (Map Name CompilationUnit)
forall e d.
Language
-> (Term -> Flow Graph e)
-> (Module
-> Map Type (Coder Graph Graph Term e)
-> [(Element, TypedTerm)]
-> Flow Graph d)
-> Module
-> Flow Graph d
transformModule Language
javaLanguage Term -> Flow Graph Expression
encode Module
-> Map Type (Coder Graph Graph Term Expression)
-> [(Element, TypedTerm)]
-> Flow Graph (Map Name CompilationUnit)
constructModule Module
mod
where
aliases :: Aliases
aliases = Module -> Aliases
importAliasesForModule Module
mod
encode :: Term -> Flow Graph Expression
encode = Aliases -> Term -> Flow Graph Expression
encodeTerm Aliases
aliases (Term -> Flow Graph Expression)
-> (Term -> Term) -> Term -> Flow Graph Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Term
contractTerm
noComment :: Java.ClassBodyDeclaration -> Java.ClassBodyDeclarationWithComments
ClassBodyDeclaration
decl = ClassBodyDeclaration
-> Maybe FilePath -> ClassBodyDeclarationWithComments
Java.ClassBodyDeclarationWithComments ClassBodyDeclaration
decl Maybe FilePath
forall a. Maybe a
Nothing
reannotate :: Maybe Type -> [Map Name Term] -> Term -> Term
reannotate Maybe Type
mtyp [Map Name Term]
anns Term
term = case Maybe Type
mtyp of
Maybe Type
Nothing -> Term
base
Just Type
typ -> TypedTerm -> Term
TermTyped (Term -> Type -> TypedTerm
TypedTerm Term
base Type
typ)
where
base :: Term
base = [Map Name Term] -> Term -> Term
reann [Map Name Term]
anns Term
term
reann :: [Map Name Term] -> Term -> Term
reann [Map Name Term]
anns Term
term = case [Map Name Term]
anns of
[] -> Term
term
(Map Name Term
h:[Map Name Term]
r) -> [Map Name Term] -> Term -> Term
reann [Map Name Term]
r (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ AnnotatedTerm -> Term
TermAnnotated (Term -> Map Name Term -> AnnotatedTerm
AnnotatedTerm Term
term Map Name Term
h)
toClassDecl :: Bool -> Bool -> Aliases -> [Java.TypeParameter]
-> Name -> Type -> Flow Graph Java.ClassDeclaration
toClassDecl :: Bool
-> Bool
-> Aliases
-> [TypeParameter]
-> Name
-> Type
-> Flow Graph ClassDeclaration
toClassDecl Bool
isInner Bool
isSer Aliases
aliases [TypeParameter]
tparams Name
elName Type
t = case Type -> Type
stripType Type
t of
TypeRecord RowType
rt -> Bool
-> Bool
-> Aliases
-> [TypeParameter]
-> Name
-> [FieldType]
-> Flow Graph ClassDeclaration
declarationForRecordType Bool
isInner Bool
isSer Aliases
aliases [TypeParameter]
tparams Name
elName ([FieldType] -> Flow Graph ClassDeclaration)
-> [FieldType] -> Flow Graph ClassDeclaration
forall a b. (a -> b) -> a -> b
$ RowType -> [FieldType]
rowTypeFields RowType
rt
TypeUnion RowType
rt -> Bool
-> Aliases
-> [TypeParameter]
-> Name
-> [FieldType]
-> Flow Graph ClassDeclaration
declarationForUnionType Bool
isSer Aliases
aliases [TypeParameter]
tparams Name
elName ([FieldType] -> Flow Graph ClassDeclaration)
-> [FieldType] -> Flow Graph ClassDeclaration
forall a b. (a -> b) -> a -> b
$ RowType -> [FieldType]
rowTypeFields RowType
rt
TypeLambda LambdaType
ut -> Bool
-> Aliases
-> [TypeParameter]
-> Name
-> LambdaType
-> Flow Graph ClassDeclaration
declarationForLambdaType Bool
isSer Aliases
aliases [TypeParameter]
tparams Name
elName LambdaType
ut
TypeWrap (WrappedType Name
tname Type
wt) -> Bool
-> Bool
-> Aliases
-> [TypeParameter]
-> Name
-> [FieldType]
-> Flow Graph ClassDeclaration
declarationForRecordType Bool
isInner Bool
isSer Aliases
aliases [TypeParameter]
tparams Name
elName
[Name -> Type -> FieldType
FieldType (FilePath -> Name
Name FilePath
"value") Type
wt]
Type
_ -> Type -> Flow Graph ClassDeclaration
wrap Type
t
where
wrap :: Type -> Flow Graph ClassDeclaration
wrap Type
t' = Bool
-> Bool
-> Aliases
-> [TypeParameter]
-> Name
-> [FieldType]
-> Flow Graph ClassDeclaration
declarationForRecordType Bool
isInner Bool
isSer Aliases
aliases [TypeParameter]
tparams Name
elName [FilePath -> Type -> FieldType
Types.field FilePath
valueFieldName (Type -> FieldType) -> Type -> FieldType
forall a b. (a -> b) -> a -> b
$ Type -> Type
stripType Type
t']
toDataDeclaration :: Aliases -> (a, TypedTerm) -> Flow Graph a
toDataDeclaration :: forall a. Aliases -> (a, TypedTerm) -> Flow Graph a
toDataDeclaration Aliases
aliases (a
el, TypedTerm Term
term Type
typ) = do
FilePath -> Flow Graph a
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"not implemented"
typeArgsOrDiamond :: [Java.TypeArgument] -> Java.TypeArgumentsOrDiamond
typeArgsOrDiamond :: [TypeArgument] -> TypeArgumentsOrDiamond
typeArgsOrDiamond [TypeArgument]
args = if JavaFeatures -> Bool
supportsDiamondOperator JavaFeatures
javaFeatures
then TypeArgumentsOrDiamond
Java.TypeArgumentsOrDiamondDiamond
else [TypeArgument] -> TypeArgumentsOrDiamond
Java.TypeArgumentsOrDiamondArguments [TypeArgument]
args