From: Ilya Portnov Date: Sat, 19 May 2012 14:35:45 +0000 (+0600) Subject: Merge branch 'master' of lenovo.local:git/hs-java X-Git-Tag: v0.3.2~10 X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=hs-java.git;a=commitdiff_plain;h=4d1941510b85901ccfd7eaf94c56c13e7cfc1c20;hp=ab7df4b6e9518cbedb49df5e510c3ababb64dada Merge branch 'master' of lenovo.local:git/hs-java Does not compile! Conflicts: Java/ClassPath.hs Java/ClassPath/Common.hs Java/JAR/Archive.hs hs-java.cabal --- diff --git a/JVM/ClassFile.hs b/JVM/ClassFile.hs index 343d956..e30eb27 100644 --- a/JVM/ClassFile.hs +++ b/JVM/ClassFile.hs @@ -207,22 +207,22 @@ type Pool stage = M.Map Word16 (Constant stage) -- | Generic .class file format data Class stage = Class { - magic :: Word32, -- ^ Magic value: 0xCAFEBABE + magic :: Word32, -- ^ Magic value: 0xCAFEBABE minorVersion :: Word16, majorVersion :: Word16, - constsPoolSize :: Word16, -- ^ Number of items in constants pool - constsPool :: Pool stage, -- ^ Constants pool itself - accessFlags :: AccessFlags stage, -- ^ See @JVM.Types.AccessFlag@ - thisClass :: Link stage B.ByteString, -- ^ Constants pool item index for this class - superClass :: Link stage B.ByteString, -- ^ --/-- for super class, zero for java.lang.Object - interfacesCount :: Word16, -- ^ Number of implemented interfaces - interfaces :: [Link stage B.ByteString], -- ^ Constants pool item indexes for implemented interfaces - classFieldsCount :: Word16, -- ^ Number of class fileds - classFields :: [Field stage], -- ^ Class fields - classMethodsCount :: Word16, -- ^ Number of class methods - classMethods :: [Method stage], -- ^ Class methods - classAttributesCount :: Word16, -- ^ Number of class attributes - classAttributes :: Attributes stage -- ^ Class attributes + constsPoolSize :: Word16, -- ^ Number of items in constants pool + constsPool :: Pool stage, -- ^ Constants pool itself + accessFlags :: AccessFlags stage, -- ^ See @JVM.Types.AccessFlag@ + thisClass :: Link stage B.ByteString, -- ^ Constants pool item index for this class + superClass :: Link stage B.ByteString, -- ^ --/-- for super class, zero for java.lang.Object + interfacesCount :: Word16, -- ^ Number of implemented interfaces + interfaces :: [Link stage B.ByteString], -- ^ Constants pool item indexes for implemented interfaces + classFieldsCount :: Word16, -- ^ Number of class fileds + classFields :: [Field stage], -- ^ Class fields + classMethodsCount :: Word16, -- ^ Number of class methods + classMethods :: [Method stage], -- ^ Class methods + classAttributesCount :: Word16, -- ^ Number of class attributes + classAttributes :: Attributes stage -- ^ Class attributes } deriving instance Eq (Class File) diff --git a/Java/ClassPath.hs b/Java/ClassPath.hs index 2dbff67..dfb7f51 100644 --- a/Java/ClassPath.hs +++ b/Java/ClassPath.hs @@ -9,7 +9,7 @@ module Java.ClassPath import qualified Control.Monad.State as St import Control.Monad.Trans (liftIO) -import System.FilePath.Glob +import System.FilePath.Glob hiding (glob) import Data.String.Utils (split) import JVM.ClassFile diff --git a/Java/ClassPath/Common.hs b/Java/ClassPath/Common.hs index e20286f..e50b1e8 100644 --- a/Java/ClassPath/Common.hs +++ b/Java/ClassPath/Common.hs @@ -3,6 +3,7 @@ module Java.ClassPath.Common where import Data.List import Data.String.Utils (split) +import System.FilePath import Java.ClassPath.Types @@ -19,6 +20,15 @@ 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 +mapFMF :: (Monad m, Functor m) => (FilePath -> t -> m a) -> [Tree t] -> m [Tree a] +mapFMF fn forest = mapM (mapTMF fn) forest + +mapTMF :: (Monad m, Functor m) => (FilePath -> t -> m a) -> Tree t -> m (Tree a) +mapTMF fn t = go "" t + where + go path (Directory dir forest) = Directory dir `fmap` mapM (go $ path dir) forest + go path (File a) = File `fmap` fn path a + -- | map on tree mapT :: (t -> a) -> Tree t -> Tree a mapT fn (Directory dir forest) = Directory dir (mapF fn forest) diff --git a/Java/JAR/Archive.hs b/Java/JAR/Archive.hs index a4dd026..5425ab5 100644 --- a/Java/JAR/Archive.hs +++ b/Java/JAR/Archive.hs @@ -1,10 +1,12 @@ -- | This module defines functions to read Java JAR files. module Java.JAR.Archive where +import Control.Monad.Trans import qualified Codec.Archive.LibZip as Zip import Data.Binary import Data.List import qualified Data.ByteString.Lazy as B +import System.FilePath import Java.ClassPath.Types import Java.ClassPath.Common @@ -31,3 +33,23 @@ readFromJAR jarfile path = do let bstr = B.pack content return $ classFile2Direct (decode bstr) +checkClassTree :: [Tree CPEntry] -> IO [Tree (FilePath, Class Direct)] +checkClassTree forest = mapFMF check forest + where + check _ (NotLoaded path) = do + cls <- parseClassFile path + return (path, cls) + check a (Loaded path cls) = return (a path, cls) + check a (NotLoadedJAR jar path) = do + cls <- readFromJAR jar (a path) + return (a path, cls) + check a (LoadedJAR _ cls) = + return (a show (thisClass cls), cls) + +zipJAR :: [Tree (FilePath, Class Direct)] -> Zip.Archive () +zipJAR forest = do + mapFM go forest + return () + where + go (path, cls) = Zip.addFile path =<< Zip.sourceBuffer (B.unpack $ encodeClass cls) + diff --git a/hs-java.cabal b/hs-java.cabal index a3b9182..0641f54 100644 --- a/hs-java.cabal +++ b/hs-java.cabal @@ -11,6 +11,7 @@ Build-Type: Simple Description: This package declares data types for Java .class files format and functions to assemble/disassemble Java bytecode. See dump-class.hs, rebuild-class.hs, TestGen.hs for examples of usage. +Bug-reports: http://home.iportnov.ru:3000/projects/hs-java/ Extra-source-files: dump-class.hs rebuild-class.hs