{-# LANGUAGE Haskell2010 #-} 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 { __ = {-# LINE 23 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat [" -- * ", (show t), "s\n", (b), ""] {-# LINE 23 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } 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 { __ = {-# LINE 32 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat [" ", (dataTName haskName), " (..),\n"] {-# LINE 32 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) in ((\_ -> let { __ = {-# LINE 33 "Foreign/Java/Bindings/Java2Haskell.hss" #-} 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"] {-# LINE 39 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) pkgModImports :: Map String JavaClass -> [JavaClass] -> String pkgModImports info classes = concatMap (format . classModName) classes where format modName = ((\_ -> let { __ = {-# LINE 44 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["import ", (modName), "__ hiding (info')\n"] {-# LINE 44 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) pkgModDecl :: Map String JavaClass -> [JavaClass] -> String pkgModDecl info classes = "" -- Modules and Boot files 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 { __ = {-# LINE 64 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["import qualified ", (package), "\n"] {-# LINE 64 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } 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 { __ = {-# LINE 69 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["classModImports in Foreign.Java.Bindings.Java2Haskell - class definition not found"] {-# LINE 71 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined)) id classBootDecl :: Map String JavaClass -> JavaClass -> String classBootDecl info clazz = ((\_ -> let { __ = {-# LINE 75 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat [""] {-# LINE 76 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } 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 { __ = {-# LINE 92 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["", (name), " :: ", (signature), "\n", (name), " = Prelude.undefined\n"] {-# LINE 95 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) | otherwise = ((\_ -> let { __ = {-# LINE 96 "Foreign/Java/Bindings/Java2Haskell.hss" #-} 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"] {-# LINE 106 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) where arrayTypes -- | any isArrayType (methodParams method) = True | (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 { __ = {-# LINE 125 "Foreign/Java/Bindings/Java2Haskell.hss" #-} 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), "@"] {-# LINE 130 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) thisArg = if isStatic then "" else ((\_ -> let { __ = {-# LINE 131 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat [" ", (head args), "' <- JNI.asObject ", (head args), "\n"] {-# LINE 131 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) readArgs = concatMap ((" " ++). uncurry readArg) (zip argsNotThis (methodParams method)) readArg name jtype = case jtype of JBoolean -> ((\_ -> let { __ = {-# LINE 134 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["", (name), "' <- JNIS.toBoolean ", (name), "\n"] {-# LINE 134 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) JChar -> ((\_ -> let { __ = {-# LINE 135 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["", (name), "' <- JNIS.toChar ", (name), "\n"] {-# LINE 135 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) JByte -> ((\_ -> let { __ = {-# LINE 136 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["", (name), "' <- JNIS.toByte ", (name), "\n"] {-# LINE 136 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) JShort -> ((\_ -> let { __ = {-# LINE 137 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["", (name), "' <- JNIS.toShort ", (name), "\n"] {-# LINE 137 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) JInt -> ((\_ -> let { __ = {-# LINE 138 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["", (name), "' <- JNIS.toInt ", (name), "\n"] {-# LINE 138 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) JLong -> ((\_ -> let { __ = {-# LINE 139 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["", (name), "' <- JNIS.toLong ", (name), "\n"] {-# LINE 139 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) JFloat -> ((\_ -> let { __ = {-# LINE 140 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["", (name), "' <- JNIS.toFloat ", (name), "\n"] {-# LINE 140 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) JDouble -> ((\_ -> let { __ = {-# LINE 141 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["", (name), "' <- JNIS.toDouble ", (name), "\n"] {-# LINE 141 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) JObj _ -> ((\_ -> let { __ = {-# LINE 142 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["", (name), "' <- Prelude.Just <$> JNI.asObject ", (name), "\n"] {-# LINE 142 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) JArr _ -> ((\_ -> let { __ = {-# LINE 143 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["", (name), "' <- JNIS.asMaybeArrayObject ", (name), "\n"] {-# LINE 143 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } 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 -- Hidden Modules and Boot files classModExports' :: Map String JavaClass -> JavaClass -> String classModExports' info clazz = ((\_ -> let { __ = {-# LINE 174 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat [" ", (tyclTName haskName), ",\n ", (dataTName haskName), " (..),\n ", (newtTName haskName), " ", (if classEnum clazz then "(..)" else ""), ",\n"] {-# LINE 178 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) where haskName = takeClassName $ classModName clazz javaName = className clazz classBootExports' :: Map String JavaClass -> JavaClass -> String classBootExports' info clazz = ((\_ -> let { __ = {-# LINE 185 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat [" ", (tyclTName haskName), ",\n ", (dataTName haskName), " (..),\n ", (newtTName haskName), ",\n"] {-# LINE 189 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } 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 { __ = {-# LINE 199 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["import qualified ", (modName), "__\n"] {-# LINE 199 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) supertypes = map (check . flip Map.lookup info) $ Set.toList $ Set.fromList (classParents clazz ++ classIfaces clazz) check = maybe (error ((\_ -> let { __ = {-# LINE 203 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["classBootImports' in Foreign.Java.Bindings.Java2Haskell - class definition not found"] {-# LINE 205 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined)) id classModImports' :: Map String JavaClass -> JavaClass -> String classModImports' info clazz = "" classBootDecl' :: Map String JavaClass -> JavaClass -> String classBootDecl' info clazz | classEnum clazz = ((\_ -> let { __ = {-# LINE 214 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["class ", (tyclTDecl), "\ndata ", (newtTDecl), " = ", (enumConstants), "\ndata ", (dataTDecl), " = ", (dataCDecl), "\n"] {-# LINE 218 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) | otherwise = ((\_ -> let { __ = {-# LINE 219 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["class ", (tyclTDecl), "\nnewtype ", (newtTDecl), " = ", (newtCDecl), " JNI.JObject\ndata ", (dataTDecl), " = ", (dataCDecl), "\n"] {-# LINE 223 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } 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 { __ = {-# LINE 231 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["(JNI.JavaObject this", (context), ") => ", (tyclTName baseName), " this"] {-# LINE 231 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) context = concatMap parentContext (classParents clazz) parentContext parent = ((\_ -> let { __ = {-# LINE 233 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat [", ", (qualifiedName), " this"] {-# LINE 233 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } 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 { __ = {-# LINE 243 "Foreign/Java/Bindings/Java2Haskell.hss" #-} 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"] {-# LINE 250 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) | otherwise = ((\_ -> let { __ = {-# LINE 251 "Foreign/Java/Bindings/Java2Haskell.hss" #-} 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"] {-# LINE 267 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } 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 { __ = {-# LINE 277 "Foreign/Java/Bindings/Java2Haskell.hss" #-} concat ["instance ", (qualifiedName), " (", (newtTDecl), ")\n"] {-# LINE 279 "Foreign/Java/Bindings/Java2Haskell.hss" #-} } in __) undefined) where parentClass = info Map.! parent modName = classModName parentClass qualifiedName = modName ++ "__." ++ (tyclTName $ takeClassName modName)