module Hydra.Ext.Java.Coder (printModule) where

import Hydra.All
import Hydra.CoreDecoding
import Hydra.Reduction
import Hydra.Ext.Java.Utils
import Hydra.Ext.Java.Language
import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms
import qualified Hydra.Impl.Haskell.Dsl.Types as Types
import qualified Hydra.Ext.Java.Syntax as Java
import Hydra.Adapters.Coders
import Hydra.Util.Codetree.Script
import Hydra.Ext.Java.Serde
import Hydra.Ext.Java.Settings
import Hydra.Adapters.UtilsEtc
import Hydra.Types.Inference
import Hydra.Util.Context

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


type Aliases = M.Map Namespace Java.PackageName

printModule :: (Ord m, Read m, Show m) => Module m -> GraphFlow m (M.Map FilePath String)
printModule :: forall m.
(Ord m, Read m, Show m) =>
Module m -> GraphFlow m (Map FilePath FilePath)
printModule Module m
mod = do
    forall s a. FilePath -> Flow s a -> Flow s a
withTrace FilePath
"encode in Java" forall a b. (a -> b) -> a -> b
$ do
      Map Name CompilationUnit
units <- forall m.
(Ord m, Read m, Show m) =>
Module m -> GraphFlow m (Map Name CompilationUnit)
moduleToJavaCompilationUnit Module m
mod
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ (Name, CompilationUnit) -> (FilePath, FilePath)
forPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a b. (a -> b) -> a -> b
$ Expr -> Expr
parenthesize forall a b. (a -> b) -> a -> b
$ CompilationUnit -> Expr
writeCompilationUnit CompilationUnit
unit)

boundTypeVariables :: Type m -> [VariableType]
boundTypeVariables :: forall m. Type m -> [VariableType]
boundTypeVariables Type m
typ = case Type m
typ of
  TypeAnnotated (Annotated Type m
typ1 m
_) -> forall m. Type m -> [VariableType]
boundTypeVariables Type m
typ1
  TypeLambda (LambdaType VariableType
v Type m
body) -> VariableType
vforall a. a -> [a] -> [a]
:(forall m. Type m -> [VariableType]
boundTypeVariables Type m
body)
  Type m
_ -> []

commentsFromElement :: Element m -> GraphFlow m (Maybe String)
commentsFromElement :: forall m. Element m -> GraphFlow m (Maybe FilePath)
commentsFromElement Element m
el = do
  Context m
cx <- forall s. Flow s s
getState
  forall m.
AnnotationClass m -> Term m -> Flow (Context m) (Maybe FilePath)
annotationClassTermDescription (forall m. Context m -> AnnotationClass m
contextAnnotations Context m
cx) (forall m. Element m -> Term m
elementData Element m
el)

commentsFromFieldType :: FieldType m -> GraphFlow m (Maybe String)
commentsFromFieldType :: forall m. FieldType m -> GraphFlow m (Maybe FilePath)
commentsFromFieldType (FieldType FieldName
_ Type m
t) = do
  Context m
cx <- forall s. Flow s s
getState
  forall m.
AnnotationClass m -> Type m -> Flow (Context m) (Maybe FilePath)
annotationClassTypeDescription (forall m. Context m -> AnnotationClass m
contextAnnotations Context m
cx) Type m
t

addComment :: Java.ClassBodyDeclaration -> FieldType m -> GraphFlow m Java.ClassBodyDeclarationWithComments
addComment :: forall m.
ClassBodyDeclaration
-> FieldType m -> GraphFlow m ClassBodyDeclarationWithComments
addComment ClassBodyDeclaration
decl FieldType m
field = ClassBodyDeclaration
-> Maybe FilePath -> ClassBodyDeclarationWithComments
Java.ClassBodyDeclarationWithComments ClassBodyDeclaration
decl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m. FieldType m -> GraphFlow m (Maybe FilePath)
commentsFromFieldType FieldType m
field

noComment :: Java.ClassBodyDeclaration -> Java.ClassBodyDeclarationWithComments
noComment :: ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment ClassBodyDeclaration
decl = ClassBodyDeclaration
-> Maybe FilePath -> ClassBodyDeclarationWithComments
Java.ClassBodyDeclarationWithComments ClassBodyDeclaration
decl forall a. Maybe a
Nothing

elementNameToFilePath :: Name -> FilePath
elementNameToFilePath :: Name -> FilePath
elementNameToFilePath Name
name = Bool -> FileExtension -> Name -> FilePath
nameToFilePath Bool
False (FilePath -> FileExtension
FileExtension FilePath
"java") forall a b. (a -> b) -> a -> b
$ Namespace -> FilePath -> Name
fromQname Namespace
ns (FilePath -> FilePath
sanitizeJavaName FilePath
local)
  where
    (Namespace
ns, FilePath
local) = Name -> (Namespace, FilePath)
toQnameEager Name
name

moduleToJavaCompilationUnit :: (Ord m, Read m, Show m) => Module m -> GraphFlow m (M.Map Name Java.CompilationUnit)
moduleToJavaCompilationUnit :: forall m.
(Ord m, Read m, Show m) =>
Module m -> GraphFlow m (Map Name CompilationUnit)
moduleToJavaCompilationUnit Module m
mod = forall m e d.
(Ord m, Read m, Show m) =>
Language m
-> (Term m -> GraphFlow m e)
-> (Module m
    -> Map (Type m) (Coder (Context m) (Context m) (Term m) e)
    -> [(Element m, TypedTerm m)]
    -> GraphFlow m d)
-> Module m
-> GraphFlow m d
transformModule forall m. Language m
javaLanguage Term m -> GraphFlow m Expression
encode forall m.
(Ord m, Read m, Show m) =>
Module m
-> Map (Type m) (Coder (Context m) (Context m) (Term m) Expression)
-> [(Element m, TypedTerm m)]
-> GraphFlow m (Map Name CompilationUnit)
constructModule Module m
mod
  where
    aliases :: Map Namespace PackageName
aliases = forall m. Module m -> Map Namespace PackageName
importAliasesForModule Module m
mod
    encode :: Term m -> GraphFlow m Expression
encode = forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ord m => Term m -> Term m
contractTerm

classModsPublic :: [Java.ClassModifier]
classModsPublic :: [ClassModifier]
classModsPublic = [ClassModifier
Java.ClassModifierPublic]

constructModule :: (Ord m, Read m, Show m)
  => Module m -> M.Map (Type m) (Coder (Context m) (Context m) (Term m) Java.Expression) -> [(Element m, TypedTerm m)]
  -> GraphFlow m (M.Map Name Java.CompilationUnit)
constructModule :: forall m.
(Ord m, Read m, Show m) =>
Module m
-> Map (Type m) (Coder (Context m) (Context m) (Term m) Expression)
-> [(Element m, TypedTerm m)]
-> GraphFlow m (Map Name CompilationUnit)
constructModule Module m
mod Map (Type m) (Coder (Context m) (Context m) (Term m) Expression)
coders [(Element m, TypedTerm m)]
pairs = do
    Context m
cx <- forall s. Flow s s
getState
    let isTypePair :: (a, TypedTerm m) -> Bool
isTypePair = forall m. Eq m => Context m -> Type m -> Bool
isType Context m
cx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. TypedTerm m -> Type m
typedTermType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
    let typePairs :: [(Element m, TypedTerm m)]
typePairs = forall a. (a -> Bool) -> [a] -> [a]
L.filter forall {a}. (a, TypedTerm m) -> Bool
isTypePair [(Element m, TypedTerm m)]
pairs
    let dataPairs :: [(Element m, TypedTerm m)]
dataPairs = forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a, TypedTerm m) -> Bool
isTypePair) [(Element m, TypedTerm m)]
pairs
    [(Name, CompilationUnit)]
typeUnits <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall {m}.
(Ord m, Read m, Show m) =>
(Element m, TypedTerm m)
-> Flow (Context m) (Name, CompilationUnit)
typeToClass [(Element m, TypedTerm m)]
typePairs
    [InterfaceMemberDeclaration]
dataMembers <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM (forall {m} {s2} {m}.
(Ord m, Show m, Read m) =>
Map (Type m) (Coder (Context m) s2 (Term m) Expression)
-> (Element m, TypedTerm m)
-> Flow (Context m) InterfaceMemberDeclaration
termToInterfaceMember Map (Type m) (Coder (Context m) (Context m) (Term m) Expression)
coders) [(Element m, TypedTerm m)]
dataPairs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ [(Name, CompilationUnit)]
typeUnits forall a. [a] -> [a] -> [a]
++ ([forall m.
Module m -> [InterfaceMemberDeclaration] -> (Name, CompilationUnit)
constructElementsInterface Module m
mod [InterfaceMemberDeclaration]
dataMembers | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [InterfaceMemberDeclaration]
dataMembers)])
  where
    pkg :: PackageDeclaration
pkg = Namespace -> PackageDeclaration
javaPackageDeclaration forall a b. (a -> b) -> a -> b
$ forall m. Module m -> Namespace
moduleNamespace Module m
mod
    aliases :: Map Namespace PackageName
aliases = forall m. Module m -> Map Namespace PackageName
importAliasesForModule Module m
mod

    typeToClass :: (Element m, TypedTerm m)
-> Flow (Context m) (Name, CompilationUnit)
typeToClass pair :: (Element m, TypedTerm m)
pair@(Element m
el, TypedTerm m
_) = do
      let imports :: [a]
imports = []
      TypeDeclarationWithComments
decl <- forall m.
(Ord m, Read m, Show m) =>
Map Namespace PackageName
-> (Element m, TypedTerm m)
-> GraphFlow m TypeDeclarationWithComments
declarationForType Map Namespace PackageName
aliases (Element m, TypedTerm m)
pair
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall m. Element m -> Name
elementName Element m
el,
        OrdinaryCompilationUnit -> CompilationUnit
Java.CompilationUnitOrdinary forall a b. (a -> b) -> a -> b
$ Maybe PackageDeclaration
-> [ImportDeclaration]
-> [TypeDeclarationWithComments]
-> OrdinaryCompilationUnit
Java.OrdinaryCompilationUnit (forall a. a -> Maybe a
Just PackageDeclaration
pkg) forall a. [a]
imports [TypeDeclarationWithComments
decl])

    termToInterfaceMember :: Map (Type m) (Coder (Context m) s2 (Term m) Expression)
-> (Element m, TypedTerm m)
-> Flow (Context m) InterfaceMemberDeclaration
termToInterfaceMember Map (Type m) (Coder (Context m) s2 (Term m) Expression)
coders (Element m, TypedTerm m)
pair = do
        forall s a. FilePath -> Flow s a -> Flow s a
withTrace (FilePath
"element " forall a. [a] -> [a] -> [a]
++ Name -> FilePath
unName (forall m. Element m -> Name
elementName Element m
el)) forall a b. (a -> b) -> a -> b
$ do
          Term m
expanded <- forall m. Ord m => Term m -> Term m
contractTerm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall m. Ord m => Term m -> GraphFlow m (Term m)
expandLambdas forall a b. (a -> b) -> a -> b
$ forall m. TypedTerm m -> Term m
typedTermTerm forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (Element m, TypedTerm m)
pair) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m. (Ord m, Show m) => Term m -> GraphFlow m (Term m)
annotateTermWithTypes
          if forall {m}. Term m -> Bool
isLambda Term m
expanded
            then forall {m} {p} {m}.
(Show m, Ord m, Read m) =>
p
-> Element m
-> Type m
-> Term m
-> Flow (Context m) InterfaceMemberDeclaration
termToMethod Map (Type m) (Coder (Context m) s2 (Term m) Expression)
coders Element m
el (forall m. TypedTerm m -> Type m
typedTermType forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (Element m, TypedTerm m)
pair) Term m
expanded
            else forall {m} {s2} {v1} {m}.
(Show m, Ord m) =>
Map (Type m) (Coder (Context m) s2 v1 Expression)
-> Element m
-> Type m
-> v1
-> Flow (Context m) InterfaceMemberDeclaration
termToConstant Map (Type m) (Coder (Context m) s2 (Term m) Expression)
coders Element m
el (forall m. TypedTerm m -> Type m
typedTermType forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (Element m, TypedTerm m)
pair) Term m
expanded
      where
        el :: Element m
el = forall a b. (a, b) -> a
fst (Element m, TypedTerm m)
pair
        isLambda :: Term m -> Bool
isLambda Term m
t = case forall m. Term m -> Term m
stripTerm Term m
t of
          TermFunction (FunctionLambda Lambda m
_) -> Bool
True
          Term m
_ -> Bool
False

    termToConstant :: Map (Type m) (Coder (Context m) s2 v1 Expression)
-> Element m
-> Type m
-> v1
-> Flow (Context m) InterfaceMemberDeclaration
termToConstant Map (Type m) (Coder (Context m) s2 v1 Expression)
coders Element m
el Type m
typ v1
term = do
      UnannType
jtype <- Type -> UnannType
Java.UnannType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m.
Show m =>
Map Namespace PackageName -> Type m -> GraphFlow m Type
encodeType Map Namespace PackageName
aliases Type m
typ
      Expression
jterm <- forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (forall a. HasCallStack => Maybe a -> a
Y.fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Type m
typ Map (Type m) (Coder (Context m) s2 v1 Expression)
coders) v1
term
      let mods :: [a]
mods = []
      let var :: VariableDeclarator
var = Identifier -> Maybe VariableInitializer -> VariableDeclarator
javaVariableDeclarator (Name -> Identifier
javaVariableName forall a b. (a -> b) -> a -> b
$ forall m. Element m -> Name
elementName Element m
el) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Expression -> VariableInitializer
Java.VariableInitializerExpression Expression
jterm
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConstantDeclaration -> InterfaceMemberDeclaration
Java.InterfaceMemberDeclarationConstant forall a b. (a -> b) -> a -> b
$ [ConstantModifier]
-> UnannType -> [VariableDeclarator] -> ConstantDeclaration
Java.ConstantDeclaration forall a. [a]
mods UnannType
jtype [VariableDeclarator
var]

    -- Lambdas cannot (in general) be turned into top-level constants, as there is no way of declaring type parameters for constants
    termToMethod :: p
-> Element m
-> Type m
-> Term m
-> Flow (Context m) InterfaceMemberDeclaration
termToMethod p
coders Element m
el Type m
typ Term m
term = case forall m. Type m -> Type m
stripType Type m
typ of
      TypeFunction (FunctionType Type m
dom Type m
cod) -> case forall m. Term m -> Term m
stripTerm Term m
term of
        TermFunction (FunctionLambda (Lambda Variable
v Term m
body)) -> do
          Type
jdom <- forall m.
Show m =>
Map Namespace PackageName -> Type m -> GraphFlow m Type
encodeType Map Namespace PackageName
aliases Type m
dom
          Type
jcod <- forall m.
Show m =>
Map Namespace PackageName -> Type m -> GraphFlow m Type
encodeType Map Namespace PackageName
aliases Type m
cod
          let mods :: [InterfaceMethodModifier]
mods = [InterfaceMethodModifier
Java.InterfaceMethodModifierStatic]
          let anns :: [a]
anns = []
          let mname :: FilePath
mname = FilePath -> FilePath
sanitizeJavaName forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
decapitalize forall a b. (a -> b) -> a -> b
$ Name -> FilePath
localNameOfEager forall a b. (a -> b) -> a -> b
$ forall m. Element m -> Name
elementName Element m
el
          let param :: FormalParameter
param = Type -> FieldName -> FormalParameter
javaTypeToJavaFormalParameter Type
jdom (FilePath -> FieldName
FieldName forall a b. (a -> b) -> a -> b
$ Variable -> FilePath
unVariable Variable
v)
          let result :: Result
result = Type -> Result
javaTypeToJavaResult Type
jcod
          Expression
jbody <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases (forall a. a -> Maybe a
Just Type m
cod) Term m
body
          let returnSt :: BlockStatement
returnSt = Statement -> BlockStatement
Java.BlockStatementStatement forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Expression
jbody
          let tparams :: [TypeParameter]
tparams = forall m. Type m -> [TypeParameter]
javaTypeParametersForType Type m
typ
          forall (m :: * -> *) a. Monad m => a -> m a
return 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 (forall a. a -> Maybe a
Just [BlockStatement
returnSt])
        Term m
_ -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
FilePath -> a1 -> m a2
unexpected FilePath
"function term" Term m
term
      Type m
_ -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
FilePath -> a1 -> m a2
unexpected FilePath
"function type" Type m
typ

constructElementsInterface :: Module m -> [Java.InterfaceMemberDeclaration] -> (Name, Java.CompilationUnit)
constructElementsInterface :: forall m.
Module m -> [InterfaceMemberDeclaration] -> (Name, CompilationUnit)
constructElementsInterface Module m
mod [InterfaceMemberDeclaration]
members = (Name
elName, CompilationUnit
cu)
  where
    cu :: CompilationUnit
cu = OrdinaryCompilationUnit -> CompilationUnit
Java.CompilationUnitOrdinary forall a b. (a -> b) -> a -> b
$ Maybe PackageDeclaration
-> [ImportDeclaration]
-> [TypeDeclarationWithComments]
-> OrdinaryCompilationUnit
Java.OrdinaryCompilationUnit (forall a. a -> Maybe a
Just PackageDeclaration
pkg) [] [TypeDeclarationWithComments
decl]
    pkg :: PackageDeclaration
pkg = Namespace -> PackageDeclaration
javaPackageDeclaration forall a b. (a -> b) -> a -> b
$ forall m. Module m -> Namespace
moduleNamespace Module m
mod
    mods :: [InterfaceModifier]
mods = [InterfaceModifier
Java.InterfaceModifierPublic]
    className :: FilePath
className = Namespace -> FilePath
elementsClassName forall a b. (a -> b) -> a -> b
$ forall m. Module m -> Namespace
moduleNamespace Module m
mod
    elName :: Name
elName = Namespace -> FilePath -> Name
fromQname (forall m. Module m -> Namespace
moduleNamespace Module m
mod) FilePath
className
    body :: InterfaceBody
body = [InterfaceMemberDeclaration] -> InterfaceBody
Java.InterfaceBody [InterfaceMemberDeclaration]
members
    itf :: TypeDeclaration
itf = InterfaceDeclaration -> TypeDeclaration
Java.TypeDeclarationInterface forall a b. (a -> b) -> a -> b
$ NormalInterfaceDeclaration -> InterfaceDeclaration
Java.InterfaceDeclarationNormalInterface 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 forall a b. (a -> b) -> a -> b
$ forall m. Module m -> Maybe FilePath
moduleDescription Module m
mod

declarationForLambdaType :: (Eq m, Ord m, Read m, Show m) => Aliases
  -> [Java.TypeParameter] -> Name -> LambdaType m -> GraphFlow m Java.ClassDeclaration
declarationForLambdaType :: forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> [TypeParameter]
-> Name
-> LambdaType m
-> GraphFlow m ClassDeclaration
declarationForLambdaType Map Namespace PackageName
aliases [TypeParameter]
tparams Name
elName (LambdaType (VariableType FilePath
v) Type m
body) =
    forall m.
(Eq m, Ord m, Read m, Show m) =>
Bool
-> Map Namespace PackageName
-> [TypeParameter]
-> Name
-> Type m
-> GraphFlow m ClassDeclaration
toClassDecl Bool
False Map Namespace PackageName
aliases ([TypeParameter]
tparams forall a. [a] -> [a] -> [a]
++ [TypeParameter
param]) Name
elName Type m
body
  where
    param :: TypeParameter
param = FilePath -> TypeParameter
javaTypeParameter forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
capitalize FilePath
v

declarationForRecordType :: (Ord m, Read m, Show m) => Bool -> Aliases -> [Java.TypeParameter] -> Name
  -> [FieldType m] -> GraphFlow m Java.ClassDeclaration
declarationForRecordType :: forall m.
(Ord m, Read m, Show m) =>
Bool
-> Map Namespace PackageName
-> [TypeParameter]
-> Name
-> [FieldType m]
-> GraphFlow m ClassDeclaration
declarationForRecordType Bool
isInner Map Namespace PackageName
aliases [TypeParameter]
tparams Name
elName [FieldType m]
fields = do
    [ClassBodyDeclaration]
memberVars <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall {m}.
Show m =>
FieldType m -> Flow (Context m) ClassBodyDeclaration
toMemberVar [FieldType m]
fields
    Context m
cx <- forall s. Flow s s
getState
    [ClassBodyDeclarationWithComments]
memberVars' <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
CM.zipWithM forall m.
ClassBodyDeclaration
-> FieldType m -> GraphFlow m ClassBodyDeclarationWithComments
addComment [ClassBodyDeclaration]
memberVars [FieldType m]
fields
    [ClassBodyDeclaration]
withMethods <- if forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [FieldType m]
fields forall a. Ord a => a -> a -> Bool
> Int
1
      then forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall {m}.
Show m =>
FieldType m -> Flow (Context m) ClassBodyDeclaration
toWithMethod [FieldType m]
fields
      else forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    ClassBodyDeclaration
cons <- Flow (Context m) ClassBodyDeclaration
constructor
    [ClassBodyDeclarationWithComments]
tn <- if Bool
isInner then forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else do
      ClassBodyDeclarationWithComments
d <- forall m.
(Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Name -> GraphFlow m ClassBodyDeclarationWithComments
typeNameDecl Map Namespace PackageName
aliases Name
elName
      forall (m :: * -> *) a. Monad m => a -> m a
return [ClassBodyDeclarationWithComments
d]
    let bodyDecls :: [ClassBodyDeclarationWithComments]
bodyDecls = [ClassBodyDeclarationWithComments]
tn forall a. [a] -> [a] -> [a]
++ [ClassBodyDeclarationWithComments]
memberVars' forall a. [a] -> [a] -> [a]
++ (ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClassBodyDeclaration
cons, ClassBodyDeclaration
equalsMethod, ClassBodyDeclaration
hashCodeMethod] forall a. [a] -> [a] -> [a]
++ [ClassBodyDeclaration]
withMethods)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName
-> [TypeParameter]
-> Name
-> [ClassModifier]
-> Maybe Name
-> [ClassBodyDeclarationWithComments]
-> ClassDeclaration
javaClassDeclaration Map Namespace PackageName
aliases [TypeParameter]
tparams Name
elName [ClassModifier]
classModsPublic forall a. Maybe a
Nothing [ClassBodyDeclarationWithComments]
bodyDecls
  where
    constructor :: Flow (Context m) ClassBodyDeclaration
constructor = do
      [FormalParameter]
params <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM (forall {m}.
Show m =>
Map Namespace PackageName
-> FieldType m -> Flow (Context m) FormalParameter
fieldTypeToFormalParam Map Namespace PackageName
aliases) [FieldType m]
fields
      let stmts :: [BlockStatement]
stmts = Statement -> BlockStatement
Java.BlockStatementStatement forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Statement
toAssignStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. FieldType m -> FieldName
fieldTypeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType m]
fields
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName
-> Name
-> Bool
-> [FormalParameter]
-> [BlockStatement]
-> ClassBodyDeclaration
makeConstructor Map Namespace PackageName
aliases Name
elName Bool
False [FormalParameter]
params [BlockStatement]
stmts

    fieldArgs :: [Expression]
fieldArgs = FieldName -> Expression
fieldNameToJavaExpression forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. FieldType m -> FieldName
fieldTypeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType m]
fields

    toMemberVar :: FieldType m -> Flow (Context m) ClassBodyDeclaration
toMemberVar (FieldType FieldName
fname Type m
ft) = do
      let mods :: [FieldModifier]
mods = [FieldModifier
Java.FieldModifierPublic, FieldModifier
Java.FieldModifierFinal]
      Type
jt <- forall m.
Show m =>
Map Namespace PackageName -> Type m -> GraphFlow m Type
encodeType Map Namespace PackageName
aliases Type m
ft
      let var :: VariableDeclarator
var = FieldName -> VariableDeclarator
fieldNameToJavaVariableDeclarator FieldName
fname
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [FieldModifier]
-> Type -> VariableDeclarator -> ClassBodyDeclaration
javaMemberField [FieldModifier]
mods Type
jt VariableDeclarator
var

    toWithMethod :: FieldType m -> Flow (Context m) ClassBodyDeclaration
toWithMethod FieldType m
field = do
      let mods :: [MethodModifier]
mods = [MethodModifier
Java.MethodModifierPublic]
      let methodName :: FilePath
methodName = FilePath
"with" forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
capitalize (FieldName -> FilePath
unFieldName forall a b. (a -> b) -> a -> b
$ forall m. FieldType m -> FieldName
fieldTypeName FieldType m
field)
      FormalParameter
param <- forall {m}.
Show m =>
Map Namespace PackageName
-> FieldType m -> Flow (Context m) FormalParameter
fieldTypeToFormalParam Map Namespace PackageName
aliases FieldType m
field
      let anns :: [a]
anns = [] -- TODO
      let result :: Result
result = ReferenceType -> Result
referenceTypeToResult forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName
-> Bool -> Name -> Maybe FilePath -> ReferenceType
nameToJavaReferenceType Map Namespace PackageName
aliases Bool
False Name
elName forall a. Maybe a
Nothing
      let consId :: Identifier
consId = FilePath -> Identifier
Java.Identifier forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
sanitizeJavaName forall a b. (a -> b) -> a -> b
$ Name -> FilePath
localNameOfEager Name
elName
      let returnStmt :: BlockStatement
returnStmt = Statement -> BlockStatement
Java.BlockStatementStatement forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName Identifier
consId forall a. Maybe a
Nothing) [Expression]
fieldArgs forall a. Maybe a
Nothing
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [MethodModifier]
-> [TypeParameter]
-> [Annotation]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> ClassBodyDeclaration
methodDeclaration [MethodModifier]
mods [] forall a. [a]
anns FilePath
methodName [FormalParameter
param] Result
result (forall a. a -> Maybe a
Just [BlockStatement
returnStmt])

    equalsMethod :: ClassBodyDeclaration
equalsMethod = [MethodModifier]
-> [TypeParameter]
-> [Annotation]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> ClassBodyDeclaration
methodDeclaration [MethodModifier]
mods [] [Annotation]
anns FilePath
"equals" [FormalParameter
param] Result
result forall a b. (a -> b) -> a -> b
$
        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 -> FieldName -> FormalParameter
javaTypeToJavaFormalParameter ([ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [] forall a. Maybe a
Nothing FilePath
"Object") (FilePath -> FieldName
FieldName FilePath
otherName)
        result :: Result
result = Type -> Result
javaTypeToJavaResult Type
javaBooleanType
        otherName :: FilePath
otherName = FilePath
"other"
        tmpName :: FilePath
tmpName = FilePath
"o"

        instanceOfStmt :: BlockStatement
instanceOfStmt = Statement -> BlockStatement
Java.BlockStatementStatement forall a b. (a -> b) -> a -> b
$ IfThenStatement -> Statement
Java.StatementIfThen forall a b. (a -> b) -> a -> b
$
            Expression -> Statement -> IfThenStatement
Java.IfThenStatement Expression
cond Statement
returnFalse
          where
            cond :: Expression
cond = UnaryExpression -> Expression
javaUnaryExpressionToJavaExpression forall a b. (a -> b) -> a -> b
$
                UnaryExpressionNotPlusMinus -> UnaryExpression
Java.UnaryExpressionOther forall a b. (a -> b) -> a -> b
$
                UnaryExpression -> UnaryExpressionNotPlusMinus
Java.UnaryExpressionNotPlusMinusNot forall a b. (a -> b) -> a -> b
$
                RelationalExpression -> UnaryExpression
javaRelationalExpressionToJavaUnaryExpression forall a b. (a -> b) -> a -> b
$
                RelationalExpression -> ReferenceType -> RelationalExpression
javaInstanceOf RelationalExpression
other ReferenceType
parent
              where
                other :: RelationalExpression
other = Identifier -> RelationalExpression
javaIdentifierToJavaRelationalExpression forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
javaIdentifier FilePath
otherName
                parent :: ReferenceType
parent = Map Namespace PackageName
-> Bool -> Name -> Maybe FilePath -> ReferenceType
nameToJavaReferenceType Map Namespace PackageName
aliases Bool
False Name
elName forall a. Maybe a
Nothing

            returnFalse :: Statement
returnFalse = Maybe Expression -> Statement
javaReturnStatement forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> Expression
javaBooleanExpression Bool
False

        castStmt :: BlockStatement
castStmt = Map Namespace PackageName
-> Name -> Identifier -> Expression -> BlockStatement
variableDeclarationStatement Map Namespace PackageName
aliases Name
elName Identifier
id Expression
rhs
          where
            id :: Identifier
id = FilePath -> Identifier
javaIdentifier FilePath
tmpName
            rhs :: Expression
rhs = CastExpression -> Expression
javaCastExpressionToJavaExpression forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName
-> ReferenceType -> UnaryExpression -> CastExpression
javaCastExpression Map Namespace PackageName
aliases ReferenceType
rt UnaryExpression
var
            var :: UnaryExpression
var = Identifier -> UnaryExpression
javaIdentifierToJavaUnaryExpression forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.Identifier forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
sanitizeJavaName FilePath
otherName
            rt :: ReferenceType
rt = Map Namespace PackageName
-> Bool -> Name -> Maybe FilePath -> ReferenceType
nameToJavaReferenceType Map Namespace PackageName
aliases Bool
False Name
elName forall a. Maybe a
Nothing

        returnAllFieldsEqual :: BlockStatement
returnAllFieldsEqual = Statement -> BlockStatement
Java.BlockStatementStatement forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [FieldType m]
fields
            then Bool -> Expression
javaBooleanExpression Bool
True
            else ConditionalAndExpression -> Expression
javaConditionalAndExpressionToJavaExpression forall a b. (a -> b) -> a -> b
$
              [InclusiveOrExpression] -> ConditionalAndExpression
Java.ConditionalAndExpression (FieldName -> InclusiveOrExpression
eqClause forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. FieldType m -> FieldName
fieldTypeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType m]
fields)
          where
            eqClause :: FieldName -> InclusiveOrExpression
eqClause (FieldName FilePath
fname) = PostfixExpression -> InclusiveOrExpression
javaPostfixExpressionToJavaInclusiveOrExpression forall a b. (a -> b) -> a -> b
$
                MethodInvocation -> PostfixExpression
javaMethodInvocationToJavaPostfixExpression 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 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 forall a b. (a -> b) -> a -> b
$ MethodInvocation_Variant
-> [TypeArgument] -> Identifier -> MethodInvocation_Complex
Java.MethodInvocation_Complex MethodInvocation_Variant
var [] (FilePath -> Identifier
Java.Identifier FilePath
"equals")
                var :: MethodInvocation_Variant
var = ExpressionName -> MethodInvocation_Variant
Java.MethodInvocation_VariantExpression forall a b. (a -> b) -> a -> b
$ Maybe AmbiguousName -> Identifier -> ExpressionName
Java.ExpressionName forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.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
"hashCode" [] Result
result forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [FieldType m]
fields
          then Statement
returnZero
          else Maybe Expression -> Statement
javaReturnStatement forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            AdditiveExpression -> Expression
javaAdditiveExpressionToJavaExpression forall a b. (a -> b) -> a -> b
$ [MultiplicativeExpression] -> AdditiveExpression
addExpressions forall a b. (a -> b) -> a -> b
$
              forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
L.zipWith Int -> FieldName -> MultiplicativeExpression
multPair [Int]
multipliers (forall m. FieldType m -> FieldName
fieldTypeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType m]
fields)
          where
            returnZero :: Statement
returnZero = Maybe Expression -> Statement
javaReturnStatement forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Expression
javaIntExpression Integer
0

            multPair :: Int -> FieldName -> Java.MultiplicativeExpression
            multPair :: Int -> FieldName -> MultiplicativeExpression
multPair Int
i (FieldName FilePath
fname) = MultiplicativeExpression_Binary -> MultiplicativeExpression
Java.MultiplicativeExpressionTimes 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 forall a b. (a -> b) -> a -> b
$ Primary -> UnaryExpression
javaPrimaryToJavaUnaryExpression forall a b. (a -> b) -> a -> b
$
                  Literal -> Primary
javaLiteralToPrimary forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Literal
javaInt Int
i
                rhs :: UnaryExpression
rhs = PostfixExpression -> UnaryExpression
javaPostfixExpressionToJavaUnaryExpression forall a b. (a -> b) -> a -> b
$
                  MethodInvocation -> PostfixExpression
javaMethodInvocationToJavaPostfixExpression forall a b. (a -> b) -> a -> b
$
                  Identifier -> Identifier -> [Expression] -> MethodInvocation
methodInvocationStatic (FilePath -> Identifier
javaIdentifier FilePath
fname) (FilePath -> Identifier
Java.Identifier FilePath
"hashCode") []

            multipliers :: [Int]
multipliers = forall a. [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 :: (Ord m, Read m, Show m)
  => Aliases -> (Element m, TypedTerm m) -> GraphFlow m Java.TypeDeclarationWithComments
declarationForType :: forall m.
(Ord m, Read m, Show m) =>
Map Namespace PackageName
-> (Element m, TypedTerm m)
-> GraphFlow m TypeDeclarationWithComments
declarationForType Map Namespace PackageName
aliases (Element m
el, TypedTerm Type m
_ Term m
term) = do
    Type m
t <- forall m. Show m => Term m -> GraphFlow m (Type m)
decodeType Term m
term forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m.
(Ord m, Read m, Show m) =>
Language m -> Type m -> GraphFlow m (Type m)
adaptType forall m. Language m
javaLanguage
    ClassDeclaration
cd <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Bool
-> Map Namespace PackageName
-> [TypeParameter]
-> Name
-> Type m
-> GraphFlow m ClassDeclaration
toClassDecl Bool
False Map Namespace PackageName
aliases [] (forall m. Element m -> Name
elementName Element m
el) Type m
t
    Context m
cx <- forall s. Flow s s
getState
    Maybe FilePath
comments <- forall m. Element m -> GraphFlow m (Maybe FilePath)
commentsFromElement Element m
el
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeDeclaration -> Maybe FilePath -> TypeDeclarationWithComments
Java.TypeDeclarationWithComments (ClassDeclaration -> TypeDeclaration
Java.TypeDeclarationClass ClassDeclaration
cd) Maybe FilePath
comments

declarationForUnionType :: (Eq m, Ord m, Read m, Show m)
  => Aliases
  -> [Java.TypeParameter] -> Name -> [FieldType m] -> GraphFlow m Java.ClassDeclaration
declarationForUnionType :: forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> [TypeParameter]
-> Name
-> [FieldType m]
-> GraphFlow m ClassDeclaration
declarationForUnionType Map Namespace PackageName
aliases [TypeParameter]
tparams Name
elName [FieldType m]
fields = do
    [ClassDeclaration]
variantClasses <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClassDeclaration -> ClassDeclaration
augmentVariantClass forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m}.
(Ord m, Read m, Show m) =>
FieldType m -> GraphFlow m ClassDeclaration
unionFieldClass) [FieldType m]
fields
    let variantDecls :: [ClassBodyDeclaration]
variantDecls = ClassMemberDeclaration -> ClassBodyDeclaration
Java.ClassBodyDeclarationClassMember forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassDeclaration -> ClassMemberDeclaration
Java.ClassMemberDeclarationClass forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClassDeclaration]
variantClasses
    Context m
cx <- forall s. Flow s s
getState
    [ClassBodyDeclarationWithComments]
variantDecls' <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
CM.zipWithM forall m.
ClassBodyDeclaration
-> FieldType m -> GraphFlow m ClassBodyDeclarationWithComments
addComment [ClassBodyDeclaration]
variantDecls [FieldType m]
fields
    let otherDecls :: [ClassBodyDeclarationWithComments]
otherDecls = ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClassBodyDeclaration
privateConstructor, Bool -> ClassBodyDeclaration
toAcceptMethod Bool
True, ClassBodyDeclaration
visitor, ClassBodyDeclaration
partialVisitor]
    ClassBodyDeclarationWithComments
tn <- forall m.
(Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Name -> GraphFlow m ClassBodyDeclarationWithComments
typeNameDecl Map Namespace PackageName
aliases Name
elName
    let bodyDecls :: [ClassBodyDeclarationWithComments]
bodyDecls = [ClassBodyDeclarationWithComments
tn] forall a. [a] -> [a] -> [a]
++ [ClassBodyDeclarationWithComments]
otherDecls forall a. [a] -> [a] -> [a]
++ [ClassBodyDeclarationWithComments]
variantDecls'
    let mods :: [ClassModifier]
mods = [ClassModifier]
classModsPublic forall a. [a] -> [a] -> [a]
++ [ClassModifier
Java.ClassModifierAbstract]
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName
-> [TypeParameter]
-> Name
-> [ClassModifier]
-> Maybe Name
-> [ClassBodyDeclarationWithComments]
-> ClassDeclaration
javaClassDeclaration Map Namespace PackageName
aliases [TypeParameter]
tparams Name
elName [ClassModifier]
mods forall a. Maybe a
Nothing [ClassBodyDeclarationWithComments]
bodyDecls
  where
    privateConstructor :: ClassBodyDeclaration
privateConstructor = Map Namespace PackageName
-> Name
-> Bool
-> [FormalParameter]
-> [BlockStatement]
-> ClassBodyDeclaration
makeConstructor Map Namespace PackageName
aliases Name
elName Bool
True [] []
    unionFieldClass :: FieldType m -> GraphFlow m ClassDeclaration
unionFieldClass (FieldType FieldName
fname Type m
ftype) = do
      let rtype :: Type m
rtype = forall m. [FieldType m] -> Type m
Types.record forall a b. (a -> b) -> a -> b
$ if forall m. Eq m => Type m -> Bool
Types.isUnit Type m
ftype then [] else [forall m. FieldName -> Type m -> FieldType m
FieldType (FilePath -> FieldName
FieldName FilePath
valueFieldName) Type m
ftype]
      forall m.
(Eq m, Ord m, Read m, Show m) =>
Bool
-> Map Namespace PackageName
-> [TypeParameter]
-> Name
-> Type m
-> GraphFlow m ClassDeclaration
toClassDecl Bool
True Map Namespace PackageName
aliases [] (Bool -> Name -> FieldName -> Name
variantClassName Bool
False Name
elName FieldName
fname) Type m
rtype
    augmentVariantClass :: ClassDeclaration -> ClassDeclaration
augmentVariantClass (Java.ClassDeclarationNormal NormalClassDeclaration
cd) = NormalClassDeclaration -> ClassDeclaration
Java.ClassDeclarationNormal forall a b. (a -> b) -> a -> b
$ NormalClassDeclaration
cd {
        normalClassDeclarationModifiers :: [ClassModifier]
Java.normalClassDeclarationModifiers = [ClassModifier
Java.ClassModifierPublic, ClassModifier
Java.ClassModifierStatic, ClassModifier
Java.ClassModifierFinal],
        normalClassDeclarationExtends :: Maybe ClassType
Java.normalClassDeclarationExtends = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName
-> Bool -> [TypeArgument] -> Name -> Maybe FilePath -> ClassType
nameToJavaClassType Map Namespace PackageName
aliases Bool
True [TypeArgument]
args Name
elName forall a. Maybe a
Nothing,
        normalClassDeclarationParameters :: [TypeParameter]
Java.normalClassDeclarationParameters = [TypeParameter]
tparams,
        normalClassDeclarationBody :: ClassBody
Java.normalClassDeclarationBody = ClassBody -> ClassBody
newBody (NormalClassDeclaration -> ClassBody
Java.normalClassDeclarationBody NormalClassDeclaration
cd)}
      where
        newBody :: ClassBody -> ClassBody
newBody (Java.ClassBody [ClassBodyDeclarationWithComments]
decls) = [ClassBodyDeclarationWithComments] -> ClassBody
Java.ClassBody forall a b. (a -> b) -> a -> b
$ [ClassBodyDeclarationWithComments]
decls forall a. [a] -> [a] -> [a]
++ [ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment forall a b. (a -> b) -> a -> b
$ Bool -> ClassBodyDeclaration
toAcceptMethod Bool
False]
        args :: [TypeArgument]
args = TypeParameter -> TypeArgument
typeParameterToTypeArgument forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeParameter]
tparams

    visitor :: ClassBodyDeclaration
visitor = NormalInterfaceDeclaration -> ClassBodyDeclaration
javaInterfaceDeclarationToJavaClassBodyDeclaration forall a b. (a -> b) -> a -> b
$
        [InterfaceModifier]
-> TypeIdentifier
-> [TypeParameter]
-> [InterfaceType]
-> InterfaceBody
-> NormalInterfaceDeclaration
Java.NormalInterfaceDeclaration [InterfaceModifier]
mods TypeIdentifier
ti [TypeParameter]
tparams forall a. [a]
extends InterfaceBody
body
      where
        mods :: [InterfaceModifier]
mods = [InterfaceModifier
Java.InterfaceModifierPublic]
        ti :: TypeIdentifier
ti = Identifier -> TypeIdentifier
Java.TypeIdentifier forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.Identifier FilePath
visitorName
        tparams :: [TypeParameter]
tparams = [FilePath -> TypeParameter
javaTypeParameter FilePath
"R"]
        extends :: [a]
extends = []
        body :: InterfaceBody
body = [InterfaceMemberDeclaration] -> InterfaceBody
Java.InterfaceBody (FieldName -> InterfaceMemberDeclaration
toVisitMethod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. FieldType m -> FieldName
fieldTypeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType m]
fields)
          where
            toVisitMethod :: FieldName -> InterfaceMemberDeclaration
toVisitMethod FieldName
fname = [InterfaceMethodModifier]
-> [TypeParameter]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> InterfaceMemberDeclaration
interfaceMethodDeclaration [] [] FilePath
visitMethodName [FieldName -> FormalParameter
variantInstanceParam FieldName
fname] Result
resultR forall a. Maybe a
Nothing

    partialVisitor :: ClassBodyDeclaration
partialVisitor = NormalInterfaceDeclaration -> ClassBodyDeclaration
javaInterfaceDeclarationToJavaClassBodyDeclaration forall a b. (a -> b) -> a -> b
$
        Java.NormalInterfaceDeclaration {
            normalInterfaceDeclarationModifiers :: [InterfaceModifier]
Java.normalInterfaceDeclarationModifiers = [InterfaceModifier
Java.InterfaceModifierPublic],
            normalInterfaceDeclarationIdentifier :: TypeIdentifier
Java.normalInterfaceDeclarationIdentifier = Identifier -> TypeIdentifier
Java.TypeIdentifier forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.Identifier FilePath
partialVisitorName,
            normalInterfaceDeclarationParameters :: [TypeParameter]
Java.normalInterfaceDeclarationParameters = [FilePath -> TypeParameter
javaTypeParameter FilePath
"R"],
            normalInterfaceDeclarationExtends :: [InterfaceType]
Java.normalInterfaceDeclarationExtends =
              [ClassType -> InterfaceType
Java.InterfaceType forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> ClassType
javaClassType [ReferenceType
visitorTypeVariable] forall a. Maybe a
Nothing FilePath
visitorName],
            normalInterfaceDeclarationBody :: InterfaceBody
Java.normalInterfaceDeclarationBody = [InterfaceMemberDeclaration] -> InterfaceBody
Java.InterfaceBody forall a b. (a -> b) -> a -> b
$ InterfaceMemberDeclaration
otherwiseforall a. a -> [a] -> [a]
:(FieldName -> InterfaceMemberDeclaration
toVisitMethod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. FieldType m -> FieldName
fieldTypeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType m]
fields)}
      where
        otherwise :: InterfaceMemberDeclaration
otherwise = [InterfaceMethodModifier]
-> [TypeParameter]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> InterfaceMemberDeclaration
interfaceMethodDeclaration [InterfaceMethodModifier]
defaultMod [] FilePath
"otherwise" [FormalParameter
mainInstanceParam] Result
resultR forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [BlockStatement
throw]
          where
            throw :: BlockStatement
throw = Statement -> BlockStatement
Java.BlockStatementStatement forall a b. (a -> b) -> a -> b
$ StatementWithoutTrailingSubstatement -> Statement
Java.StatementWithoutTrailing forall a b. (a -> b) -> a -> b
$
                ThrowStatement -> StatementWithoutTrailingSubstatement
Java.StatementWithoutTrailingSubstatementThrow forall a b. (a -> b) -> a -> b
$ Expression -> ThrowStatement
Java.ThrowStatement forall a b. (a -> b) -> a -> b
$
                ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName (FilePath -> Identifier
Java.Identifier FilePath
"IllegalStateException") forall a. Maybe a
Nothing) [Expression]
args forall a. Maybe a
Nothing
              where
                args :: [Expression]
args = [AdditiveExpression -> Expression
javaAdditiveExpressionToJavaExpression forall a b. (a -> b) -> a -> b
$ [MultiplicativeExpression] -> AdditiveExpression
addExpressions [
                  FilePath -> MultiplicativeExpression
javaStringMultiplicativeExpression FilePath
"Non-exhaustive patterns when matching: ",
                  UnaryExpression -> MultiplicativeExpression
Java.MultiplicativeExpressionUnary forall a b. (a -> b) -> a -> b
$ Identifier -> UnaryExpression
javaIdentifierToJavaUnaryExpression forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
Java.Identifier FilePath
"instance"]]

        toVisitMethod :: FieldName -> InterfaceMemberDeclaration
toVisitMethod FieldName
fname = [InterfaceMethodModifier]
-> [TypeParameter]
-> FilePath
-> [FormalParameter]
-> Result
-> Maybe [BlockStatement]
-> InterfaceMemberDeclaration
interfaceMethodDeclaration [InterfaceMethodModifier]
defaultMod [] FilePath
visitMethodName [FieldName -> FormalParameter
variantInstanceParam FieldName
fname] Result
resultR forall a b. (a -> b) -> a -> b
$
            forall a. a -> Maybe a
Just [BlockStatement
returnOtherwise]
          where
            returnOtherwise :: BlockStatement
returnOtherwise = Statement -> BlockStatement
Java.BlockStatementStatement forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
              Primary -> Expression
javaPrimaryToJavaExpression forall a b. (a -> b) -> a -> b
$ PrimaryNoNewArray -> Primary
Java.PrimaryNoNewArray forall a b. (a -> b) -> a -> b
$ MethodInvocation -> PrimaryNoNewArray
Java.PrimaryNoNewArrayMethodInvocation forall a b. (a -> b) -> a -> b
$
              Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation forall a. Maybe a
Nothing (FilePath -> Identifier
Java.Identifier FilePath
"otherwise") [Identifier -> Expression
javaIdentifierToJavaExpression 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 forall a b. (a -> b) -> a -> b
$ ReferenceType -> Type
Java.TypeReference ReferenceType
visitorTypeVariable

    mainInstanceParam :: FormalParameter
mainInstanceParam = Type -> FieldName -> FormalParameter
javaTypeToJavaFormalParameter Type
classRef forall a b. (a -> b) -> a -> b
$ FilePath -> FieldName
FieldName FilePath
instanceName
      where
        classRef :: Type
classRef = ClassType -> Type
javaClassTypeToJavaType forall a b. (a -> b) -> a -> b
$
          Map Namespace PackageName
-> Bool -> [TypeArgument] -> Name -> Maybe FilePath -> ClassType
nameToJavaClassType Map Namespace PackageName
aliases Bool
False [] Name
elName forall a. Maybe a
Nothing

    variantInstanceParam :: FieldName -> FormalParameter
variantInstanceParam FieldName
fname = Type -> FieldName -> FormalParameter
javaTypeToJavaFormalParameter Type
classRef forall a b. (a -> b) -> a -> b
$ FilePath -> FieldName
FieldName FilePath
instanceName
      where
        classRef :: Type
classRef = ClassType -> Type
javaClassTypeToJavaType forall a b. (a -> b) -> a -> b
$
          Map Namespace PackageName
-> Bool -> [TypeArgument] -> Name -> Maybe FilePath -> ClassType
nameToJavaClassType Map Namespace PackageName
aliases Bool
False [] (Bool -> Name -> FieldName -> Name
variantClassName Bool
False Name
elName FieldName
fname) forall a. Maybe a
Nothing

elementJavaIdentifier :: Aliases -> Name -> Java.Identifier
elementJavaIdentifier :: Map Namespace PackageName -> Name -> Identifier
elementJavaIdentifier Map Namespace PackageName
aliases Name
name = FilePath -> Identifier
Java.Identifier forall a b. (a -> b) -> a -> b
$ FilePath
jname forall a. [a] -> [a] -> [a]
++ FilePath
"." forall a. [a] -> [a] -> [a]
++ FilePath
local
  where
    (Namespace
gname, FilePath
local) = Name -> (Namespace, FilePath)
toQnameEager Name
name
    Java.Identifier FilePath
jname = Map Namespace PackageName -> Name -> Identifier
nameToJavaName Map Namespace PackageName
aliases forall a b. (a -> b) -> a -> b
$ Namespace -> FilePath -> Name
fromQname Namespace
gname forall a b. (a -> b) -> a -> b
$ Namespace -> FilePath
elementsClassName Namespace
gname

elementsClassName :: Namespace -> String
elementsClassName :: Namespace -> FilePath
elementsClassName (Namespace FilePath
ns) = FilePath -> FilePath
capitalize forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
L.last forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [[a]]
LS.splitOn FilePath
"/" FilePath
ns

encodeElimination :: (Eq m, Ord m, Read m, Show m)
  => Aliases -> Maybe Java.Expression -> Type m -> Type m -> Elimination m -> GraphFlow m Java.Expression
encodeElimination :: forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe Expression
-> Type m
-> Type m
-> Elimination m
-> GraphFlow m Expression
encodeElimination Map Namespace PackageName
aliases Maybe Expression
marg Type m
dom Type m
cod Elimination m
elm = case Elimination m
elm of
  Elimination m
EliminationElement -> case Maybe Expression
marg of
    Maybe Expression
Nothing -> forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Type m -> Type m -> Function m -> GraphFlow m Expression
encodeFunction Map Namespace PackageName
aliases Type m
dom Type m
cod forall a b. (a -> b) -> a -> b
$ forall m. Lambda m -> Function m
FunctionLambda forall a b. (a -> b) -> a -> b
$ forall m. Variable -> Term m -> Lambda m
Lambda Variable
var forall a b. (a -> b) -> a -> b
$ forall m. Variable -> Term m
TermVariable Variable
var
      where
        var :: Variable
var = FilePath -> Variable
Variable FilePath
"v"
    Just Expression
jarg -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
jarg
  EliminationNominal Name
name -> case Maybe Expression
marg of
    Maybe Expression
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Variable -> Expression -> Expression
javaLambda Variable
var Expression
jbody
      where
        var :: Variable
var = FilePath -> Variable
Variable FilePath
"v"
        arg :: Expression
arg = Identifier -> Expression
javaIdentifierToJavaExpression forall a b. (a -> b) -> a -> b
$ Variable -> Identifier
variableToJavaIdentifier Variable
var
        jbody :: Expression
jbody = ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName (Map Namespace PackageName -> Name -> Identifier
nameToJavaName Map Namespace PackageName
aliases Name
name) forall a. Maybe a
Nothing) [Expression
arg] forall a. Maybe a
Nothing
    Just Expression
jarg -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FieldAccess -> Expression
javaFieldAccessToJavaExpression 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 forall a b. (a -> b) -> a -> b
$ Expression -> Primary
javaExpressionToJavaPrimary Expression
jarg
--  EliminationOptional (OptionalCases nothing just) ->
  EliminationRecord (Projection Name
_ FieldName
fname) -> do
    ReferenceType
jdomr <- forall m.
Show m =>
Map Namespace PackageName -> Type m -> GraphFlow m Type
encodeType Map Namespace PackageName
aliases Type m
dom forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m. Type -> GraphFlow m ReferenceType
javaTypeToJavaReferenceType
    Expression
jexp <- case Maybe Expression
marg of
      Maybe Expression
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Variable -> Expression -> Expression
javaLambda Variable
var Expression
jbody
        where
          var :: Variable
var = FilePath -> Variable
Variable FilePath
"v"
          jbody :: Expression
jbody = ExpressionName -> Expression
javaExpressionNameToJavaExpression forall a b. (a -> b) -> a -> b
$
            Identifier -> Identifier -> ExpressionName
fieldExpression (Variable -> Identifier
variableToJavaIdentifier Variable
var) (FilePath -> Identifier
javaIdentifier forall a b. (a -> b) -> a -> b
$ FieldName -> FilePath
unFieldName FieldName
fname)
      Just Expression
jarg -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FieldAccess -> Expression
javaFieldAccessToJavaExpression forall a b. (a -> b) -> a -> b
$ FieldAccess_Qualifier -> Identifier -> FieldAccess
Java.FieldAccess FieldAccess_Qualifier
qual (FilePath -> Identifier
javaIdentifier forall a b. (a -> b) -> a -> b
$ FieldName -> FilePath
unFieldName FieldName
fname)
        where
          qual :: FieldAccess_Qualifier
qual = Primary -> FieldAccess_Qualifier
Java.FieldAccess_QualifierPrimary forall a b. (a -> b) -> a -> b
$ Expression -> Primary
javaExpressionToJavaPrimary Expression
jarg
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CastExpression -> Expression
javaCastExpressionToJavaExpression forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName
-> ReferenceType -> UnaryExpression -> CastExpression
javaCastExpression Map Namespace PackageName
aliases ReferenceType
jdomr forall a b. (a -> b) -> a -> b
$ Expression -> UnaryExpression
javaExpressionToJavaUnaryExpression Expression
jexp
  EliminationUnion (CaseStatement Name
tname [Field m]
fields) -> case Maybe Expression
marg of
      Maybe Expression
Nothing -> do
        Context m
cx <- forall s. Flow s s
getState
        let anns :: AnnotationClass m
anns = forall m. Context m -> AnnotationClass m
contextAnnotations Context m
cx
        let lhs :: Term m
lhs = forall m.
AnnotationClass m
-> Context m -> Maybe (Type m) -> Term m -> Term m
annotationClassSetTermType AnnotationClass m
anns Context m
cx (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m -> Type m
Types.function (forall m. Name -> Type m
Types.nominal Name
tname) Type m
cod) forall a b. (a -> b) -> a -> b
$ forall m. Elimination m -> Term m
Terms.elimination Elimination m
elm
        forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall m. FilePath -> Term m -> Term m
Terms.lambda FilePath
"v" forall a b. (a -> b) -> a -> b
$ forall m. Term m -> Term m -> Term m
Terms.apply Term m
lhs (forall m. FilePath -> Term m
Terms.variable FilePath
"v")
      Just Expression
jarg -> Expression -> GraphFlow m Expression
applyElimination Expression
jarg
    where
      applyElimination :: Expression -> GraphFlow m Expression
applyElimination Expression
jarg = do
          let prim :: Primary
prim = Expression -> Primary
javaExpressionToJavaPrimary Expression
jarg
          let consId :: Identifier
consId = Map Namespace PackageName -> Name -> FilePath -> Identifier
innerClassRef Map Namespace PackageName
aliases Name
tname FilePath
visitorName
          Type
jcod <- forall m.
Show m =>
Map Namespace PackageName -> Type m -> GraphFlow m Type
encodeType Map Namespace PackageName
aliases Type m
cod
          let targs :: TypeArgumentsOrDiamond
targs = [TypeArgument] -> TypeArgumentsOrDiamond
Java.TypeArgumentsOrDiamondArguments [Type -> TypeArgument
javaTypeToJavaTypeArgument Type
jcod]
          ClassBody
body <- [ClassBodyDeclarationWithComments] -> ClassBody
Java.ClassBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM (Type
-> Field m -> Flow (Context m) ClassBodyDeclarationWithComments
bodyDecl Type
jcod) [Field m]
fields
          let visitor :: Expression
visitor = ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName Identifier
consId forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just TypeArgumentsOrDiamond
targs) [] (forall a. a -> Maybe a
Just ClassBody
body)
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression forall a b. (a -> b) -> a -> b
$
            Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Primary
prim) (FilePath -> Identifier
Java.Identifier FilePath
"accept") [Expression
visitor]
        where
          bodyDecl :: Type
-> Field m -> Flow (Context m) ClassBodyDeclarationWithComments
bodyDecl Type
jcod Field m
field = do
            let jdom :: Type
jdom = ReferenceType -> Type
Java.TypeReference forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName
-> Bool -> Name -> Maybe FilePath -> ReferenceType
nameToJavaReferenceType Map Namespace PackageName
aliases Bool
True Name
tname (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
capitalize forall a b. (a -> b) -> a -> b
$ FieldName -> FilePath
unFieldName forall a b. (a -> b) -> a -> b
$ forall m. Field m -> FieldName
fieldName Field m
field)
            let mods :: [MethodModifier]
mods = [MethodModifier
Java.MethodModifierPublic]
            let anns :: [Annotation]
anns = [Annotation
overrideAnnotation]
            let param :: FormalParameter
param = Type -> FieldName -> FormalParameter
javaTypeToJavaFormalParameter Type
jdom forall a b. (a -> b) -> a -> b
$ FilePath -> FieldName
FieldName FilePath
instanceName
            let result :: Result
result = UnannType -> Result
Java.ResultType forall a b. (a -> b) -> a -> b
$ Type -> UnannType
Java.UnannType Type
jcod
            -- Note: the escaping is necessary because the instance.value field reference does not correspond to an actual Hydra projection term
            let value :: Term m
value = forall m. FilePath -> Term m
Terms.variable (FilePath
"$" forall a. [a] -> [a] -> [a]
++ FilePath
instanceName forall a. [a] -> [a] -> [a]
++ FilePath
"." forall a. [a] -> [a] -> [a]
++ FilePath
valueFieldName)
            Expression
jret <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases (forall a. a -> Maybe a
Just Type m
cod) forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
contractTerm forall a b. (a -> b) -> a -> b
$ forall m. Term m -> Term m -> Term m
Terms.apply (forall m. Field m -> Term m
fieldTerm Field m
field) forall {m}. Term m
value
            let returnStmt :: BlockStatement
returnStmt = Statement -> BlockStatement
Java.BlockStatementStatement forall a b. (a -> b) -> a -> b
$ Maybe Expression -> Statement
javaReturnStatement forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Expression
jret

            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment 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 (forall a. a -> Maybe a
Just [BlockStatement
returnStmt])
  Elimination m
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Literal -> Expression
encodeLiteral forall a b. (a -> b) -> a -> b
$ FilePath -> Literal
LiteralString forall a b. (a -> b) -> a -> b
$
    FilePath
"Unimplemented elimination variant: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (forall m. Elimination m -> EliminationVariant
eliminationVariant Elimination m
elm) -- TODO: temporary

encodeFunction :: (Eq m, Ord m, Read m, Show m)
  => Aliases -> Type m -> Type m -> Function m -> GraphFlow m Java.Expression
encodeFunction :: forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Type m -> Type m -> Function m -> GraphFlow m Expression
encodeFunction Map Namespace PackageName
aliases Type m
dom Type m
cod Function m
fun = case Function m
fun of
--  FunctionCompareTo other ->
  FunctionElimination Elimination m
elm -> forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe Expression
-> Type m
-> Type m
-> Elimination m
-> GraphFlow m Expression
encodeElimination Map Namespace PackageName
aliases forall a. Maybe a
Nothing Type m
dom Type m
cod Elimination m
elm
  FunctionLambda (Lambda Variable
var Term m
body) -> do
    Expression
jbody <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases forall a. Maybe a
Nothing Term m
body
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Variable -> Expression -> Expression
javaLambda Variable
var Expression
jbody
--  FunctionPrimitive name ->
  Function m
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Literal -> Expression
encodeLiteral forall a b. (a -> b) -> a -> b
$ FilePath -> Literal
LiteralString forall a b. (a -> b) -> a -> b
$
    FilePath
"Unimplemented function variant: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (forall m. Function m -> FunctionVariant
functionVariant Function m
fun) -- TODO: temporary

encodeLiteral :: Literal -> Java.Expression
encodeLiteral :: Literal -> Expression
encodeLiteral Literal
lit = Literal -> Expression
javaLiteralToJavaExpression 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 forall a b. (a -> b) -> a -> b
$ Double -> FloatingPointLiteral
Java.FloatingPointLiteral forall a b. (a -> b) -> a -> b
$ case FloatValue
f of
    FloatValueFloat32 Float
v -> 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 -- BigInteger
      IntegerValueInt16 Int
v -> Int -> Literal
int Int
v -- short
      IntegerValueInt32 Int
v -> Int -> Literal
int Int
v -- int
      IntegerValueInt64 Integer
v -> Integer -> Literal
integer Integer
v -- long
      IntegerValueUint8 Int
v -> Int -> Literal
int Int
v -- byte
      IntegerValueUint16 Int
v -> Int -> Literal
Java.LiteralCharacter forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v -- char
    where
      integer :: Integer -> Literal
integer = IntegerLiteral -> Literal
Java.LiteralInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> IntegerLiteral
Java.IntegerLiteral
      int :: Int -> Literal
int = Integer -> Literal
integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  LiteralString FilePath
s -> FilePath -> Literal
javaString FilePath
s

-- Note: we use Java object types everywhere, rather than primitive types, as the latter cannot be used
--       to build function types, parameterized types, etc.
encodeLiteralType :: LiteralType -> GraphFlow m Java.Type
encodeLiteralType :: forall m. LiteralType -> GraphFlow m Type
encodeLiteralType LiteralType
lt = case LiteralType
lt of
    LiteralType
LiteralTypeBoolean -> forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Boolean"
    LiteralTypeFloat FloatType
ft -> case FloatType
ft of
      FloatType
FloatTypeFloat32 -> forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Float"
      FloatType
FloatTypeFloat64 -> forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Double"
      FloatType
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"unexpected float type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FloatType
ft
    LiteralTypeInteger IntegerType
it -> case IntegerType
it of
      IntegerType
IntegerTypeBigint -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [] (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [FilePath] -> PackageName
javaPackageName [FilePath
"java", FilePath
"math"]) FilePath
"BigInteger"
      IntegerType
IntegerTypeInt16 -> forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Short"
      IntegerType
IntegerTypeInt32 -> forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Integer"
      IntegerType
IntegerTypeInt64 -> forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Long"
      IntegerType
IntegerTypeUint8 -> forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Byte"
      IntegerType
IntegerTypeUint16 -> forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"Character"
      IntegerType
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"unexpected integer type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show IntegerType
it
    LiteralType
LiteralTypeString -> forall {f :: * -> *}. Applicative f => FilePath -> f Type
simple FilePath
"String"
    LiteralType
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"unexpected literal type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show LiteralType
lt
  where
    simple :: FilePath -> f Type
simple FilePath
n = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [] forall a. Maybe a
Nothing FilePath
n

encodeTerm :: (Eq m, Ord m, Read m, Show m)
  => Aliases -> Maybe (Type m) -> Term m -> GraphFlow m Java.Expression
encodeTerm :: forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases Maybe (Type m)
mtype Term m
term = case Term m
term of
    -- Note: we are currently only reading the type from the annotation, leaving any documentation etc. behind
    TermAnnotated (Annotated Term m
term' m
ann) -> case Maybe (Type m)
mtype of
      Just Type m
t -> forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases Maybe (Type m)
mtype Term m
term'
      Maybe (Type m)
Nothing -> do
        Context m
cx <- forall s. Flow s s
getState
        Maybe (Type m)
mt <- forall m.
AnnotationClass m -> m -> Flow (Context m) (Maybe (Type m))
annotationClassTypeOf (forall m. Context m -> AnnotationClass m
contextAnnotations Context m
cx) m
ann
        forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases Maybe (Type m)
mt Term m
term'

    TermApplication Application m
a -> case forall m. Term m -> Term m
stripTerm Term m
fun of
        TermFunction Function m
f -> case Function m
f of
          FunctionPrimitive Name
name -> Name -> [Term m] -> GraphFlow m Expression
forNamedFunction Name
name [Term m]
args
          FunctionElimination Elimination m
EliminationElement -> if forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Term m]
args forall a. Ord a => a -> a -> Bool
> Int
0
            then case forall m. Term m -> Term m
stripTerm (forall a. [a] -> a
L.head [Term m]
args) of
              TermElement Name
name -> do
                Name -> [Term m] -> GraphFlow m Expression
forNamedFunction Name
name (forall a. [a] -> [a]
L.tail [Term m]
args)
              Term m
_ -> GraphFlow m Expression
fallback
            else GraphFlow m Expression
fallback
          Function m
_ -> GraphFlow m Expression
fallback
        Term m
_ -> GraphFlow m Expression
fallback
      where
        forNamedFunction :: Name -> [Term m] -> GraphFlow m Expression
forNamedFunction Name
name [Term m]
args = do
          [Expression]
jargs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM Term m -> GraphFlow m Expression
encode [Term m]
args
          let header :: MethodInvocation_Header
header = MethodName -> MethodInvocation_Header
Java.MethodInvocation_HeaderSimple forall a b. (a -> b) -> a -> b
$ Identifier -> MethodName
Java.MethodName forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName -> Name -> Identifier
elementJavaIdentifier Map Namespace PackageName
aliases Name
name
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression forall a b. (a -> b) -> a -> b
$ MethodInvocation_Header -> [Expression] -> MethodInvocation
Java.MethodInvocation MethodInvocation_Header
header [Expression]
jargs

        (Term m
fun, [Term m]
args) = forall {m}. [Term m] -> Term m -> (Term m, [Term m])
uncurry [] Term m
term
          where
            uncurry :: [Term m] -> Term m -> (Term m, [Term m])
uncurry [Term m]
args Term m
term = case Term m
term of
              TermAnnotated (Annotated Term m
body m
_) -> [Term m] -> Term m -> (Term m, [Term m])
uncurry [Term m]
args Term m
body
              TermApplication (Application Term m
lhs Term m
rhs) -> [Term m] -> Term m -> (Term m, [Term m])
uncurry (Term m
rhsforall a. a -> [a] -> [a]
:[Term m]
args) Term m
lhs
              Term m
_ -> (Term m
term, [Term m]
args)

        fallback :: GraphFlow m Expression
fallback = Application m -> GraphFlow m Expression
forApplication Application m
a
        forApplication :: Application m -> GraphFlow m Expression
forApplication (Application Term m
lhs Term m
rhs) = do
            Context m
cx <- forall s. Flow s s
getState
            Maybe (Type m)
mt <- forall m.
AnnotationClass m -> Term m -> Flow (Context m) (Maybe (Type m))
annotationClassTermType (forall m. Context m -> AnnotationClass m
contextAnnotations Context m
cx) Term m
lhs
            Type m
t <- case Maybe (Type m)
mt of
              Just Type m
t' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Type m
t'
              Maybe (Type m)
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"expected a type annotation on function " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Term m
lhs
            (Type m
dom, Type m
cod) <- case forall m. Type m -> Type m
stripType Type m
t of
                TypeFunction (FunctionType Type m
dom Type m
cod) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type m
dom, Type m
cod)
                Type m
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"expected a function type on function " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Term m
lhs
            case forall m. Term m -> Term m
stripTerm Term m
lhs of
              TermFunction Function m
f -> case Function m
f of
                FunctionElimination Elimination m
e -> case Elimination m
e of
                  Elimination m
EliminationElement -> forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases forall a. Maybe a
Nothing Term m
rhs
                  Elimination m
_ -> do
                    Expression
jarg <- Term m -> GraphFlow m Expression
encode Term m
rhs
                    forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe Expression
-> Type m
-> Type m
-> Elimination m
-> GraphFlow m Expression
encodeElimination Map Namespace PackageName
aliases (forall a. a -> Maybe a
Just Expression
jarg) Type m
dom Type m
cod Elimination m
e
                Function m
_ -> Type m -> Type m -> GraphFlow m Expression
defaultExpression Type m
dom Type m
cod
              Term m
_ -> Type m -> Type m -> GraphFlow m Expression
defaultExpression Type m
dom Type m
cod
          where
            defaultExpression :: Type m -> Type m -> GraphFlow m Expression
defaultExpression Type m
dom Type m
cod = do
              -- Note: the domain type will not be used, so we just substitute the unit type
              Expression
jfun <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m -> Type m
Types.function Type m
dom Type m
cod) Term m
lhs
              Expression
jarg <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases (forall a. a -> Maybe a
Just Type m
dom) Term m
rhs
              let prim :: Primary
prim = Expression -> Primary
javaExpressionToJavaPrimary Expression
jfun
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression forall a b. (a -> b) -> a -> b
$ Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Primary
prim) (FilePath -> Identifier
Java.Identifier FilePath
"apply") [Expression
jarg]

    TermElement Name
name -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Identifier -> Expression
javaIdentifierToJavaExpression forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName -> Name -> Identifier
elementJavaIdentifier Map Namespace PackageName
aliases Name
name

    TermFunction Function m
f -> case Maybe (Type m)
mtype of
      Just Type m
t -> case forall m. Type m -> Type m
stripType Type m
t of
        TypeFunction (FunctionType Type m
dom Type m
cod) -> forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Type m -> Type m -> Function m -> GraphFlow m Expression
encodeFunction Map Namespace PackageName
aliases Type m
dom Type m
cod Function m
f
        Type m
_ -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
FilePath -> a1 -> m a2
unexpected FilePath
"function type" forall a b. (a -> b) -> a -> b
$ Type m
t
      Maybe (Type m)
Nothing -> forall {f :: * -> *}. Applicative f => FilePath -> f Expression
failAsLiteral forall a b. (a -> b) -> a -> b
$ FilePath
"unannotated function: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Function m
f

    TermList [Term m]
els -> do
      [Expression]
jels <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM Term m -> GraphFlow m Expression
encode [Term m]
els
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Literal -> Expression
encodeLiteral Literal
l

  --  TermMap (Map (Term m) (Term m))

    TermNominal (Named Name
name Term m
arg) -> do
      Expression
jarg <- Term m -> GraphFlow m Expression
encode Term m
arg
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName (Map Namespace PackageName -> Name -> Identifier
nameToJavaName Map Namespace PackageName
aliases Name
name) forall a. Maybe a
Nothing) [Expression
jarg] forall a. Maybe a
Nothing

    TermOptional Maybe (Term m)
mt -> case Maybe (Term m)
mt of
      Maybe (Term m)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression forall a b. (a -> b) -> a -> b
$
        Identifier -> Identifier -> [Expression] -> MethodInvocation
methodInvocationStatic (FilePath -> Identifier
javaIdentifier FilePath
"java.util.Optional") (FilePath -> Identifier
Java.Identifier FilePath
"empty") []
      Just Term m
term1 -> do
        Expression
expr <- Term m -> GraphFlow m Expression
encode Term m
term1
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression forall a b. (a -> b) -> a -> b
$
          Identifier -> Identifier -> [Expression] -> MethodInvocation
methodInvocationStatic (FilePath -> Identifier
javaIdentifier FilePath
"java.util.Optional") (FilePath -> Identifier
Java.Identifier FilePath
"of") [Expression
expr]

    TermRecord (Record Name
name [Field m]
fields) -> do
      [Expression]
fieldExprs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM Term m -> GraphFlow m Expression
encode (forall m. Field m -> Term m
fieldTerm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field m]
fields)
      let consId :: Identifier
consId = Map Namespace PackageName -> Name -> Identifier
nameToJavaName Map Namespace PackageName
aliases Name
name
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName Identifier
consId forall a. Maybe a
Nothing) [Expression]
fieldExprs forall a. Maybe a
Nothing

    TermSet Set (Term m)
s -> do
      [Expression]
jels <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM Term m -> GraphFlow m Expression
encode forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set (Term m)
s
      let prim :: Primary
prim = MethodInvocation -> Primary
javaMethodInvocationToJavaPrimary 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 forall a b. (a -> b) -> a -> b
$
                 Identifier -> Identifier -> [Expression] -> MethodInvocation
methodInvocationStatic (FilePath -> Identifier
javaIdentifier FilePath
"java.util.stream.Collectors") (FilePath -> Identifier
Java.Identifier FilePath
"toSet") []
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MethodInvocation -> Expression
javaMethodInvocationToJavaExpression forall a b. (a -> b) -> a -> b
$
        Maybe (Either ExpressionName Primary)
-> Identifier -> [Expression] -> MethodInvocation
methodInvocation (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Primary
prim) (FilePath -> Identifier
Java.Identifier FilePath
"collect") [Expression
coll]

    TermUnion (Union Name
name (Field (FieldName FilePath
fname) Term m
v)) -> do
      let (Java.Identifier FilePath
typeId) = Map Namespace PackageName -> Name -> Identifier
nameToJavaName Map Namespace PackageName
aliases Name
name
      let consId :: Identifier
consId = FilePath -> Identifier
Java.Identifier forall a b. (a -> b) -> a -> b
$ FilePath
typeId forall a. [a] -> [a] -> [a]
++ FilePath
"." forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
sanitizeJavaName (FilePath -> FilePath
capitalize FilePath
fname)
      [Expression]
args <- if forall m. Eq m => Term m -> Bool
Terms.isUnit Term m
v
        then forall (m :: * -> *) a. Monad m => a -> m a
return []
        else do
          Expression
ex <- Term m -> GraphFlow m Expression
encode Term m
v
          forall (m :: * -> *) a. Monad m => a -> m a
return [Expression
ex]
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName Identifier
consId forall a. Maybe a
Nothing) [Expression]
args forall a. Maybe a
Nothing

    TermVariable (Variable FilePath
v) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Identifier -> Expression
javaIdentifierToJavaExpression forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
javaIdentifier FilePath
v

    Term m
_ -> forall {f :: * -> *}. Applicative f => FilePath -> f Expression
failAsLiteral forall a b. (a -> b) -> a -> b
$ FilePath
"Unimplemented term variant: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (forall m. Term m -> TermVariant
termVariant Term m
term)
  where
    encode :: Term m -> GraphFlow m Expression
encode = forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases forall a. Maybe a
Nothing

    failAsLiteral :: FilePath -> f Expression
failAsLiteral FilePath
msg = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Literal -> Expression
encodeLiteral forall a b. (a -> b) -> a -> b
$ FilePath -> Literal
LiteralString FilePath
msg

encodeType :: Show m => Aliases -> Type m -> GraphFlow m Java.Type
encodeType :: forall m.
Show m =>
Map Namespace PackageName -> Type m -> GraphFlow m Type
encodeType Map Namespace PackageName
aliases Type m
t = case forall m. Type m -> Type m
stripType Type m
t of
  TypeApplication (ApplicationType Type m
lhs Type m
rhs) -> do
    Type
jlhs <- Type m -> GraphFlow m Type
encode Type m
lhs
    ReferenceType
jrhs <- Type m -> GraphFlow m Type
encode Type m
rhs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m. Type -> GraphFlow m ReferenceType
javaTypeToJavaReferenceType
    forall m. ReferenceType -> Type -> GraphFlow m Type
addJavaTypeParameter ReferenceType
jrhs Type
jlhs
  TypeElement Type m
et -> Type m -> GraphFlow m Type
encode Type m
et -- Elements are simply unboxed
  TypeFunction (FunctionType Type m
dom Type m
cod) -> do
    ReferenceType
jdom <- Type m -> GraphFlow m Type
encode Type m
dom forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m. Type -> GraphFlow m ReferenceType
javaTypeToJavaReferenceType
    ReferenceType
jcod <- Type m -> GraphFlow m Type
encode Type m
cod forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m. Type -> GraphFlow m ReferenceType
javaTypeToJavaReferenceType
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType
jdom, ReferenceType
jcod] Maybe PackageName
javaUtilFunctionPackageName FilePath
"Function"
  TypeLambda (LambdaType (VariableType FilePath
v) Type m
body) -> do
    Type
jbody <- Type m -> GraphFlow m Type
encode Type m
body
    forall m. ReferenceType -> Type -> GraphFlow m Type
addJavaTypeParameter (FilePath -> ReferenceType
javaTypeVariable FilePath
v) Type
jbody
  TypeList Type m
et -> do
    Type
jet <- Type m -> GraphFlow m Type
encode Type m
et
    if Bool
listsAsArrays
      then forall m. Type -> GraphFlow m Type
toJavaArrayType Type
jet
      else do
        ReferenceType
rt <- forall m. Type -> GraphFlow m ReferenceType
javaTypeToJavaReferenceType Type
jet
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType
rt] Maybe PackageName
javaUtilPackageName FilePath
"List"
  TypeLiteral LiteralType
lt -> forall m. LiteralType -> GraphFlow m Type
encodeLiteralType LiteralType
lt
  TypeMap (MapType Type m
kt Type m
vt) -> do
    ReferenceType
jkt <- Type m -> GraphFlow m Type
encode Type m
kt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m. Type -> GraphFlow m ReferenceType
javaTypeToJavaReferenceType
    ReferenceType
jvt <- Type m -> GraphFlow m Type
encode Type m
vt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m. Type -> GraphFlow m ReferenceType
javaTypeToJavaReferenceType
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType
jkt, ReferenceType
jvt] Maybe PackageName
javaUtilPackageName FilePath
"Map"
  TypeNominal Name
name -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ReferenceType -> Type
Java.TypeReference forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName
-> Bool -> Name -> Maybe FilePath -> ReferenceType
nameToJavaReferenceType Map Namespace PackageName
aliases Bool
True Name
name forall a. Maybe a
Nothing
  TypeRecord (RowType Name
_UnitType Maybe Name
_ []) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [] Maybe PackageName
javaLangPackageName FilePath
"Void"
  TypeRecord (RowType Name
name Maybe Name
_ [FieldType m]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ReferenceType -> Type
Java.TypeReference forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName
-> Bool -> Name -> Maybe FilePath -> ReferenceType
nameToJavaReferenceType Map Namespace PackageName
aliases Bool
True Name
name forall a. Maybe a
Nothing
  TypeOptional Type m
ot -> do
    ReferenceType
jot <- Type m -> GraphFlow m Type
encode Type m
ot forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m. Type -> GraphFlow m ReferenceType
javaTypeToJavaReferenceType
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType
jot] Maybe PackageName
javaUtilPackageName FilePath
"Optional"
  TypeSet Type m
st -> do
    ReferenceType
jst <- Type m -> GraphFlow m Type
encode Type m
st forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m. Type -> GraphFlow m ReferenceType
javaTypeToJavaReferenceType
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ReferenceType] -> Maybe PackageName -> FilePath -> Type
javaRefType [ReferenceType
jst] Maybe PackageName
javaUtilPackageName FilePath
"Set"
  TypeUnion (RowType Name
name Maybe Name
_ [FieldType m]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ReferenceType -> Type
Java.TypeReference forall a b. (a -> b) -> a -> b
$ Map Namespace PackageName
-> Bool -> Name -> Maybe FilePath -> ReferenceType
nameToJavaReferenceType Map Namespace PackageName
aliases Bool
True Name
name forall a. Maybe a
Nothing
  TypeVariable (VariableType FilePath
v) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ReferenceType -> Type
Java.TypeReference forall a b. (a -> b) -> a -> b
$ FilePath -> ReferenceType
javaTypeVariable FilePath
v
  Type m
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"can't encode unsupported type in Java: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Type m
t
  where
    encode :: Type m -> GraphFlow m Type
encode = forall m.
Show m =>
Map Namespace PackageName -> Type m -> GraphFlow m Type
encodeType Map Namespace PackageName
aliases

fieldTypeToFormalParam :: Map Namespace PackageName
-> FieldType m -> Flow (Context m) FormalParameter
fieldTypeToFormalParam Map Namespace PackageName
aliases (FieldType FieldName
fname Type m
ft) = do
  Type
jt <- forall m.
Show m =>
Map Namespace PackageName -> Type m -> GraphFlow m Type
encodeType Map Namespace PackageName
aliases Type m
ft
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Type -> FieldName -> FormalParameter
javaTypeToJavaFormalParameter Type
jt FieldName
fname

getCodomain :: Show m => m -> GraphFlow m (Type m)
getCodomain :: forall m. Show m => m -> GraphFlow m (Type m)
getCodomain m
ann = forall m. FunctionType m -> Type m
functionTypeCodomain forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m. Show m => m -> GraphFlow m (FunctionType m)
getFunctionType m
ann

getFunctionType :: Show m => m -> GraphFlow m (FunctionType m)
getFunctionType :: forall m. Show m => m -> GraphFlow m (FunctionType m)
getFunctionType m
ann = do
  Context m
cx <- forall s. Flow s s
getState
  Maybe (Type m)
mt <- forall m.
AnnotationClass m -> m -> Flow (Context m) (Maybe (Type m))
annotationClassTypeOf (forall m. Context m -> AnnotationClass m
contextAnnotations Context m
cx) m
ann
  case Maybe (Type m)
mt of
    Maybe (Type m)
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"type annotation is required for function and elimination terms in Java"
    Just Type m
t -> case Type m
t of
      TypeFunction FunctionType m
ft -> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionType m
ft
      Type m
_ -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
FilePath -> a1 -> m a2
unexpected FilePath
"function type" Type m
t

innerClassRef :: Aliases -> Name -> String -> Java.Identifier
innerClassRef :: Map Namespace PackageName -> Name -> FilePath -> Identifier
innerClassRef Map Namespace PackageName
aliases Name
name FilePath
local = FilePath -> Identifier
Java.Identifier forall a b. (a -> b) -> a -> b
$ FilePath
id forall a. [a] -> [a] -> [a]
++ FilePath
"." forall a. [a] -> [a] -> [a]
++ FilePath
local
  where
    Java.Identifier FilePath
id = Map Namespace PackageName -> Name -> Identifier
nameToJavaName Map Namespace PackageName
aliases Name
name

instanceName :: FilePath
instanceName = FilePath
"instance"

javaTypeParametersForType :: Type m -> [Java.TypeParameter]
javaTypeParametersForType :: forall m. Type m -> [TypeParameter]
javaTypeParametersForType Type m
typ = VariableType -> TypeParameter
toParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VariableType]
vars
  where
    toParam :: VariableType -> TypeParameter
toParam (VariableType FilePath
v) = [TypeParameterModifier]
-> TypeIdentifier -> Maybe TypeBound -> TypeParameter
Java.TypeParameter [] (FilePath -> TypeIdentifier
javaTypeIdentifier forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
capitalize FilePath
v) forall a. Maybe a
Nothing
--    vars = boundTypeVariables typ
    vars :: [VariableType]
vars = forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Set VariableType
freeVariablesInType Type m
typ -- TODO: the fact that the variables are free is a bug, not a feature

partialVisitorName :: String
partialVisitorName :: FilePath
partialVisitorName = FilePath
"PartialVisitor"

toClassDecl :: (Eq m, Ord m, Read m, Show m) => Bool -> Aliases -> [Java.TypeParameter]
  -> Name -> Type m -> GraphFlow m Java.ClassDeclaration
toClassDecl :: forall m.
(Eq m, Ord m, Read m, Show m) =>
Bool
-> Map Namespace PackageName
-> [TypeParameter]
-> Name
-> Type m
-> GraphFlow m ClassDeclaration
toClassDecl Bool
isInner Map Namespace PackageName
aliases [TypeParameter]
tparams Name
elName Type m
t = case forall m. Type m -> Type m
stripType Type m
t of
    TypeRecord RowType m
rt -> forall m.
(Ord m, Read m, Show m) =>
Bool
-> Map Namespace PackageName
-> [TypeParameter]
-> Name
-> [FieldType m]
-> GraphFlow m ClassDeclaration
declarationForRecordType Bool
isInner Map Namespace PackageName
aliases [TypeParameter]
tparams Name
elName forall a b. (a -> b) -> a -> b
$ forall m. RowType m -> [FieldType m]
rowTypeFields RowType m
rt
    TypeUnion RowType m
rt -> forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> [TypeParameter]
-> Name
-> [FieldType m]
-> GraphFlow m ClassDeclaration
declarationForUnionType Map Namespace PackageName
aliases [TypeParameter]
tparams Name
elName forall a b. (a -> b) -> a -> b
$ forall m. RowType m -> [FieldType m]
rowTypeFields RowType m
rt
    TypeLambda LambdaType m
ut -> forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> [TypeParameter]
-> Name
-> LambdaType m
-> GraphFlow m ClassDeclaration
declarationForLambdaType Map Namespace PackageName
aliases [TypeParameter]
tparams Name
elName LambdaType m
ut
    -- Other types are not supported as class declarations, so we wrap them as record types.
    Type m
_ -> forall {m}.
(Ord m, Read m, Show m) =>
Type m -> GraphFlow m ClassDeclaration
wrap Type m
t -- TODO: wrap and unwrap the corresponding terms as record terms.
  where
    wrap :: Type m -> GraphFlow m ClassDeclaration
wrap Type m
t' = forall m.
(Ord m, Read m, Show m) =>
Bool
-> Map Namespace PackageName
-> [TypeParameter]
-> Name
-> [FieldType m]
-> GraphFlow m ClassDeclaration
declarationForRecordType Bool
isInner Map Namespace PackageName
aliases [TypeParameter]
tparams Name
elName [forall m. FilePath -> Type m -> FieldType m
Types.field FilePath
valueFieldName Type m
t']

toDataDeclaration :: Aliases -> (a, TypedTerm m) -> GraphFlow m a
toDataDeclaration :: forall a m.
Map Namespace PackageName -> (a, TypedTerm m) -> GraphFlow m a
toDataDeclaration Map Namespace PackageName
aliases (a
el, TypedTerm Type m
typ Term m
term) = do
  forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"not implemented" -- TODO

typeNameDecl :: (Ord m, Read m, Show m) => Aliases -> Name -> GraphFlow m Java.ClassBodyDeclarationWithComments
typeNameDecl :: forall m.
(Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Name -> GraphFlow m ClassBodyDeclarationWithComments
typeNameDecl Map Namespace PackageName
aliases Name
name = do
  Type
jt <- forall m.
Show m =>
Map Namespace PackageName -> Type m -> GraphFlow m Type
encodeType Map Namespace PackageName
aliases forall a b. (a -> b) -> a -> b
$ forall m. Name -> Type m
Types.nominal Name
_Name
  Expression
arg <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Map Namespace PackageName
-> Maybe (Type m) -> Term m -> GraphFlow m Expression
encodeTerm Map Namespace PackageName
aliases forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall m. FilePath -> Term m
Terms.string forall a b. (a -> b) -> a -> b
$ Name -> FilePath
unName Name
name
  let init :: VariableInitializer
init = Expression -> VariableInitializer
Java.VariableInitializerExpression forall a b. (a -> b) -> a -> b
$ ClassOrInterfaceTypeToInstantiate
-> [Expression] -> Maybe ClassBody -> Expression
javaConstructorCall (Identifier
-> Maybe TypeArgumentsOrDiamond
-> ClassOrInterfaceTypeToInstantiate
javaConstructorName Identifier
nameName forall a. Maybe a
Nothing) [Expression
arg] forall a. Maybe a
Nothing
  let var :: VariableDeclarator
var = Identifier -> Maybe VariableInitializer -> VariableDeclarator
javaVariableDeclarator (FilePath -> Identifier
Java.Identifier FilePath
"NAME") (forall a. a -> Maybe a
Just VariableInitializer
init)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ClassBodyDeclaration -> ClassBodyDeclarationWithComments
noComment 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 = Map Namespace PackageName -> Name -> Identifier
nameToJavaName Map Namespace PackageName
aliases Name
_Name

valueFieldName :: String
valueFieldName :: FilePath
valueFieldName = FilePath
"value"

visitMethodName :: String
visitMethodName :: FilePath
visitMethodName = FilePath
"visit"

visitorName :: String
visitorName :: FilePath
visitorName = FilePath
"Visitor"