java-bridge-0.20130606.3: dist/build/Foreign/Java/Bindings/Java2Haskell.hs
{-# 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)