-- | Generate monad
type Generate a = StateT GState IO a
+-- | Update ClassPath
withClassPath :: ClassPath () -> Generate ()
withClassPath cp = do
res <- liftIO $ execClassPath cp
endMethod
return (NameType name sig)
+-- | Get a class from current ClassPath
getClass :: String -> Generate (Class Direct)
getClass name = do
cp <- St.gets classPath
Just (LoadedJAR _ c) -> return c
Nothing -> fail $ "No such class in ClassPath: " ++ name
+-- | Get class field signature from current ClassPath
getClassField :: String -> B.ByteString -> Generate (NameType Field)
getClassField clsName fldName = do
cls <- getClass clsName
Just fld -> return (fieldNameType fld)
Nothing -> fail $ "No such field in class " ++ clsName ++ ": " ++ toString fldName
+-- | Get class method signature from current ClassPath
getClassMethod :: String -> B.ByteString -> Generate (NameType Method)
getClassMethod clsName mName = do
cls <- getClass clsName
generate cp name gen = do
let generator = do
initClass name
- st <- St.get
- St.put $ st {classPath = cp}
gen
- res <- execStateT generator emptyGState
+ res <- execStateT generator (emptyGState {classPath = cp})
let code = genCode res
d = defaultClass :: Class Direct
return $ d {
import Java.ClassPath.Types
+-- | map on forest
mapF :: (t -> a) -> [Tree t] -> [Tree a]
mapF fn forest = map (mapT fn) forest
+-- | mapM on forest
+mapFM :: (Monad m, Functor m) => (t -> m a) -> [Tree t] -> m [Tree a]
mapFM fn forest = mapM (mapTM fn) forest
+-- | mapM on tree
+mapTM :: (Monad m, Functor m) => (t -> m a) -> Tree t -> m (Tree a)
mapTM fn (Directory dir forest) = Directory dir `fmap` mapFM fn forest
mapTM fn (File a) = File `fmap` fn a
+-- | map on tree
mapT :: (t -> a) -> Tree t -> Tree a
mapT fn (Directory dir forest) = Directory dir (mapF fn forest)
mapT fn (File a) = File (fn a)
+-- | Build tree from list of filenames.
+-- For example, ["org/haskell", "org/java"] --> [org/{haskell, java}]
buildTree :: [FilePath] -> [Tree FilePath]
buildTree strs =
let build :: [[String]] -> [Tree FilePath]
in build ls
+-- | Merge ClassPath forest.
+-- For example, [org/haskell, org/java] --> [org/{haskell, java}].
merge :: [Tree CPEntry] -> [Tree CPEntry]
merge [] = []
merge [t1,t2] = merge1 [t1] t2
merge (t:ts) = foldl merge1 [t] ts
+-- | Add one ClassPath tree to forest.
merge1 :: [Tree CPEntry] -> Tree CPEntry -> [Tree CPEntry]
merge1 [] x = [x]
merge1 (x@(File e): es) y@(File e') | e == e' = x: es
import JVM.ClassFile
+-- | Directories tree
data Tree a =
Directory FilePath [Tree a]
| File a
show (Directory dir forest) = dir ++ "/{" ++ intercalate ", " (map show forest) ++ "}"
show (File a) = show a
+-- | ClassPath entry
data CPEntry =
- NotLoaded FilePath
- | Loaded FilePath (Class Direct)
- | NotLoadedJAR FilePath FilePath
- | LoadedJAR FilePath (Class Direct)
+ NotLoaded FilePath -- ^ Not loaded .class file
+ | Loaded FilePath (Class Direct) -- ^ Class loaded from .class file
+ | NotLoadedJAR FilePath FilePath -- ^ Not loaded .jar file
+ | LoadedJAR FilePath (Class Direct) -- ^ Class loaded from .jar file
deriving (Eq)
instance Show CPEntry where
show (NotLoadedJAR jar path) = "<Not loaded JAR: " ++ jar ++ ": " ++ path ++ ">"
show (LoadedJAR path cls) = "<Read JAR: " ++ path ++ ": " ++ toString (thisClass cls) ++ ">"
+-- | ClassPath monad
type ClassPath a = StateT [Tree CPEntry] IO a
-
+-- | This module defines functions to read Java JAR files.
module Java.JAR.Archive where
import Control.Monad.Trans
import JVM.ClassFile
import JVM.Converter
+-- | Read all entires from JAR file
readJAR :: FilePath -> IO [Tree CPEntry]
readJAR jarfile = do
files <- Zip.withArchive [] jarfile $ Zip.fileNames []
return $ mapF (NotLoadedJAR jarfile) (buildTree files)
+-- | Read one class from JAR file
readFromJAR :: FilePath -> FilePath -> IO (Class Direct)
readFromJAR jarfile path = do
content <- Zip.withArchive [] jarfile $ Zip.fileContents [] path
let bstr = B.pack content
return $ classFile2Direct (decode bstr)
+-- | Add given JAR file to ClassPath
addJAR :: FilePath -> ClassPath ()
addJAR jarfile = do
classes <- liftIO $ readJAR jarfile
-
+-- | This module declares functions and data types for
+-- JAR meta-information classes, such as MANIFEST.MF etc.
module Java.META
(module Java.META.Types,
module Java.META.Parser,
import Java.META.Parser
import Java.META.Spec
+-- | JAR MANIFEST.MF
data Manifest = Manifest {
manifestVersion :: String,
createdBy :: String,
manifestEntries :: [ManifestEntry]}
deriving (Eq, Show)
+-- | Manifest entry
data ManifestEntry = ManifestEntry {
meName :: String,
meSealed :: Bool,
-module Java.META.Parser where
+module Java.META.Parser
+ (parseMetaFile) where
import qualified Data.Map as M
import Text.Parsec
test :: Generate ()
test = do
withClassPath $ do
+ -- Add current directory (with Hello.class) to ClassPath
addDirectory "."
+ -- Load method signature: Hello.hello()
helloJava <- getClassMethod "./Hello" "hello"
+ -- Initializer method. Just calls java.lang.Object.<init>
newMethod [ACC_PUBLIC] "<init>" [] ReturnsVoid $ do
setStackSize 1
invokeSpecial Java.Lang.object Java.Lang.objectInit
i0 RETURN
+ -- Declare hello() method and bind it's signature to hello.
hello <- newMethod [ACC_PUBLIC, ACC_STATIC] "hello" [IntType] ReturnsVoid $ do
setStackSize 8
pop
i0 RETURN
+ -- Main class method.
newMethod [ACC_PUBLIC, ACC_STATIC] "main" [arrayOf Java.Lang.stringClass] ReturnsVoid $ do
setStackSize 1
iconst_5
+ -- Call previously declared method
invokeStatic "Test" hello
i0 RETURN
return ()
+main :: IO ()
main = do
testClass <- generate [] "Test" test
B.writeFile "Test.class" (encodeClass testClass)
projects / hs-java.git / commitdiff