module Foreign.Java.Bindings.Java2Haskell where
import Foreign.Java.Util
import Foreign.Java.Utils
import Foreign.Java.Bindings.JavaTypes
import Foreign.Java.Bindings.Typomatic
import Data.Map (Map)
import Data.Function
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.List.HIUtils as HI
import Control.Arrow
pkgModExports :: Map String JavaClass -> [JavaClass] -> String
pkgModExports info classes = concatMap (\(t, b) -> ((\_ -> let { __ =
concat [" -- * ", (show t), "s\n", (b), ""]
} in __) undefined))
$ map (second $ concatMap format)
$ HI.aggregateAL
$ zip (map classType classes) classes
where
format clazz =
let haskName = takeClassName $ classModName clazz
javaName = className clazz
dataDecl = if classIface clazz then "" else
((\_ -> let { __ =
concat [" ", (dataTName haskName), " (..),\n"]
} in __) undefined)
in ((\_ -> let { __ =
concat [" -- ** ", (show $ classType clazz), " ", (javaName), "\n -- | For constructors, methods, and so on, see: \"", (classModName clazz), "\".\n ", (tyclTName haskName), ",\n", (dataDecl), " ", (newtTName haskName), " ", (if classEnum clazz then "(..)" else ""), ",\n"]
} in __) undefined)
pkgModImports :: Map String JavaClass -> [JavaClass] -> String
pkgModImports info classes = concatMap (format . classModName) classes
where format modName = ((\_ -> let { __ =
concat ["import ", (modName), "__ hiding (info')\n"]
} in __) undefined)
pkgModDecl :: Map String JavaClass -> [JavaClass] -> String
pkgModDecl info classes = ""
classBootExports :: Map String JavaClass -> JavaClass -> String
classBootExports info clazz = ""
classBootImports :: Map String JavaClass -> JavaClass -> String
classBootImports info clazz = ""
classModImports :: Map String JavaClass -> JavaClass -> String
classModImports info clazz = concatMap format references
where
format package = ((\_ -> let { __ =
concat ["import qualified ", (package), "\n"]
} in __) undefined)
references = Set.toList
$ Set.map (fst . splitClassName . classModName . check . flip Map.lookup info)
$ Set.fromList (classFullName clazz : dependencies)
dependencies = classDependencies clazz
check = maybe (error ((\_ -> let { __ =
concat ["classModImports in Foreign.Java.Bindings.Java2Haskell - class definition not found"]
} in __) undefined)) id
classBootDecl :: Map String JavaClass -> JavaClass -> String
classBootDecl info clazz = ((\_ -> let { __ =
concat [""]
} in __) undefined)
classModExports :: Map String JavaClass -> JavaClass -> String
classModExports info clazz = " -- * Methods\n" ++ concatMap methodExport methodNames
where
methods = List.sortBy (compare `on` methodName) (classMethods clazz)
methodNames = mkMethodNames methods
methodExport name = name ++ ", \n"
classModDecl :: Map String JavaClass -> JavaClass -> String
classModDecl info clazz = concatMap methodDecl $ zip methodNames methods
where
methods = List.sortBy (compare `on` methodName) (classMethods clazz)
methodNames = mkMethodNames methods
methodDecl (name, method)
| arrayTypes = ((\_ -> let { __ =
concat ["", (name), " :: ", (signature), "\n", (name), " = Prelude.undefined\n"]
} in __) undefined)
| otherwise = ((\_ -> let { __ =
concat ["", (haddock), "\n", (name), " :: ", (signature), "\n", (name), "", (argsDecl), " = do\n (Prelude.Just clazz) <- JNI.getClass \"", (classFullName clazz), "\"\n (Prelude.Just method) <- clazz `JNI.", (getMethod), "` ", (jniSignature), "\n", (thisArg), "", (readArgs), " result <- JNI.", (callMethod), " method ", (argsRefs), "\n ", (convertResult), " result\n"]
} in __) undefined)
where
arrayTypes
| (Just ret) <- methodReturnType method = isArrayType ret
| otherwise = False
isArrayType x = case x of JArr _ -> True ; _ -> False
isStatic = methodStatic method
javaSignature = fJavaSignature argsInfo
javaReturnType = fJavaReturnType argsInfo
jniSignature = fJniSignature argsInfo
signature = fSignature argsInfo
getMethod = if isStatic then "getStaticMethod" else "getMethod"
callMethod = if isStatic then "callStaticMethodE" else "callMethodE"
args = fArgNames argsInfo
argsNotThis = (if isStatic then id else tail) args
argsInfo = runTypomatic info (typomatic clazz method)
argsDecl = concatMap (' ':) args
argsRefs = concatMap (++ "' ") args
haddock = ((\_ -> let { __ =
concat ["-- | @", (if isStatic then "static " else "virtual "), "", (if methodSynchronized method then "synchronized " else ""), "", (if methodNative method then "native " else ""), "", (if methodFinal method then "final " else ""), "", (javaSignature), " -> ", (javaReturnType), "@"]
} in __) undefined)
thisArg = if isStatic then "" else ((\_ -> let { __ =
concat [" ", (head args), "' <- JNI.asObject ", (head args), "\n"]
} in __) undefined)
readArgs = concatMap ((" " ++). uncurry readArg) (zip argsNotThis (methodParams method))
readArg name jtype = case jtype of
JBoolean -> ((\_ -> let { __ =
concat ["", (name), "' <- JNIS.toBoolean ", (name), "\n"]
} in __) undefined)
JChar -> ((\_ -> let { __ =
concat ["", (name), "' <- JNIS.toChar ", (name), "\n"]
} in __) undefined)
JByte -> ((\_ -> let { __ =
concat ["", (name), "' <- JNIS.toByte ", (name), "\n"]
} in __) undefined)
JShort -> ((\_ -> let { __ =
concat ["", (name), "' <- JNIS.toShort ", (name), "\n"]
} in __) undefined)
JInt -> ((\_ -> let { __ =
concat ["", (name), "' <- JNIS.toInt ", (name), "\n"]
} in __) undefined)
JLong -> ((\_ -> let { __ =
concat ["", (name), "' <- JNIS.toLong ", (name), "\n"]
} in __) undefined)
JFloat -> ((\_ -> let { __ =
concat ["", (name), "' <- JNIS.toFloat ", (name), "\n"]
} in __) undefined)
JDouble -> ((\_ -> let { __ =
concat ["", (name), "' <- JNIS.toDouble ", (name), "\n"]
} in __) undefined)
JObj _ -> ((\_ -> let { __ =
concat ["", (name), "' <- Prelude.Just <$> JNI.asObject ", (name), "\n"]
} in __) undefined)
JArr _ -> ((\_ -> let { __ =
concat ["", (name), "' <- JNIS.asMaybeArrayObject ", (name), "\n"]
} in __) undefined)
convertResult = ("JNIS." ++) $ case methodReturnType method of
Nothing -> "toVoidResult"
Just t -> case t of
JBoolean -> "toBooleanResult"
JChar -> "toCharResult"
JByte -> "toByteResult"
JShort -> "toShortResult"
JInt -> "toIntResult"
JLong -> "toLongResult"
JFloat -> "toFloatResult"
JDouble -> "toDoubleResult"
JObj n -> "toObjectResult"
JArr c -> "toArrayResult"
mkMethodNames :: [JavaMethod] -> [String]
mkMethodNames = concatMap (zipWith (flip (++)) (iterate (++"'") ""))
. List.group . map sanitize . map methodName
where
sanitize name
| Char.isUpper (head name) = '_' : name
| name `elem` haskellKeywords = name ++ "'"
| otherwise = name
classModExports' :: Map String JavaClass -> JavaClass -> String
classModExports' info clazz = ((\_ -> let { __ =
concat [" ", (tyclTName haskName), ",\n ", (dataTName haskName), " (..),\n ", (newtTName haskName), " ", (if classEnum clazz then "(..)" else ""), ",\n"]
} in __) undefined)
where
haskName = takeClassName $ classModName clazz
javaName = className clazz
classBootExports' :: Map String JavaClass -> JavaClass -> String
classBootExports' info clazz = ((\_ -> let { __ =
concat [" ", (tyclTName haskName), ",\n ", (dataTName haskName), " (..),\n ", (newtTName haskName), ",\n"]
} in __) undefined)
where
haskName = takeClassName $ classModName clazz
javaName = className clazz
classBootImports' :: Map String JavaClass -> JavaClass -> String
classBootImports' info clazz
= concatMap (format . classModName) supertypes
where
format modName = ((\_ -> let { __ =
concat ["import qualified ", (modName), "__\n"]
} in __) undefined)
supertypes = map (check . flip Map.lookup info)
$ Set.toList
$ Set.fromList (classParents clazz ++ classIfaces clazz)
check = maybe (error ((\_ -> let { __ =
concat ["classBootImports' in Foreign.Java.Bindings.Java2Haskell - class definition not found"]
} in __) undefined)) id
classModImports' :: Map String JavaClass -> JavaClass -> String
classModImports' info clazz = ""
classBootDecl' :: Map String JavaClass -> JavaClass -> String
classBootDecl' info clazz
| classEnum clazz = ((\_ -> let { __ =
concat ["class ", (tyclTDecl), "\ndata ", (newtTDecl), " = ", (enumConstants), "\ndata ", (dataTDecl), " = ", (dataCDecl), "\n"]
} in __) undefined)
| otherwise = ((\_ -> let { __ =
concat ["class ", (tyclTDecl), "\nnewtype ", (newtTDecl), " = ", (newtCDecl), " JNI.JObject\ndata ", (dataTDecl), " = ", (dataCDecl), "\n"]
} in __) undefined)
where baseName = takeClassName $ classModName clazz
params = concatMap (\(p:ps) -> ' ' : Char.toLower p : ps)
$ map (tyVarName . paramName) $ classTypeParams clazz
newtTDecl = newtTName baseName ++ params
newtCDecl = newtCName baseName
dataTDecl = dataTName baseName ++ params
dataCDecl = dataCName baseName ++ params
tyclTDecl = ((\_ -> let { __ =
concat ["(JNI.JavaObject this", (context), ") => ", (tyclTName baseName), " this"]
} in __) undefined)
context = concatMap parentContext (classParents clazz)
parentContext parent = ((\_ -> let { __ =
concat [", ", (qualifiedName), " this"]
} in __) undefined)
where parentClass = info Map.! parent
modName = classModName parentClass
qualifiedName = modName ++ "__." ++ (tyclTName $ takeClassName modName)
enumConstants = concat $ List.intersperse " | " $ map sanitize $ map snd $ classEnumConstants clazz
where sanitize (x:xs) = Char.toUpper x : xs
classModDecl' :: Map String JavaClass -> JavaClass -> String
classModDecl' info clazz
| classEnum clazz = ((\_ -> let { __ =
concat ["instance JNI.JavaObject (", (newtTDecl), ") where\n asObject = Prelude.undefined\ninstance ", (tyclTName baseName), " (", (newtTDecl), ")\ninstance JNIS.InstanceOf (", (dataTDecl), ") where\n type CoercedType (", (dataTDecl), ") = (", (newtTDecl), ")\n", (instances), "\n"]
} in __) undefined)
| otherwise = ((\_ -> let { __ =
concat ["instance JNI.JavaObject (", (newtTDecl), ") where\n asObject (", (newtCName baseName), " obj) = return obj\ninstance JNIS.UnsafeCast (", (newtTDecl), ") where\n unsafeFromJObject obj = return (", (newtCDecl), " obj)\ninstance ", (tyclTName baseName), " (", (newtTDecl), ")\ninstance JNIS.InstanceOf (", (dataTDecl), ") where\n type CoercedType (", (dataTDecl), ") = (", (newtTDecl), ")\n coerce o t = do\n obj <- JNI.asObject o\n (Prelude.Just clazz) <- JNI.getClass \"", (fullClassName), "\"\n isInstanceOf <- obj `JNI.isInstanceOf` clazz\n if isInstanceOf\n then Prelude.Just <$> (JNIS.unsafeFromJObject obj)\n else return Prelude.Nothing\n", (instances), "\n"]
} in __) undefined)
where fullClassName = classFullName clazz
baseName = takeClassName $ classModName clazz
params = concatMap (\(p:ps) -> ' ' : Char.toLower p : ps)
$ map (tyVarName . paramName) $ classTypeParams clazz
newtTDecl = newtTName baseName ++ params
newtCDecl = newtCName baseName
dataTDecl = dataTName baseName ++ params
dataCDecl = dataCName baseName ++ params
instances = concatMap parentInstance (classParents clazz)
parentInstance parent = ((\_ -> let { __ =
concat ["instance ", (qualifiedName), " (", (newtTDecl), ")\n"]
} in __) undefined)
where parentClass = info Map.! parent
modName = classModName parentClass
qualifiedName = modName ++ "__." ++ (tyclTName $ takeClassName modName)