Java/JAR/Archive.hs

   1 -- | This module defines functions to read Java JAR files.
   2 module Java.JAR.Archive where
   3
   4 import Control.Monad.Trans
   5 import qualified Codec.Archive.LibZip as Zip
   6 import Data.Binary
   7 import Data.List
   8 import qualified Data.ByteString.Lazy as B
   9 import System.FilePath
  10
  11 import Java.ClassPath.Types
  12 import Java.ClassPath.Common
  13 import JVM.ClassFile
  14 import JVM.Converter
  15
  16 readJAREntry :: (Enum a) => FilePath -> String -> IO (Maybe [a])
  17 readJAREntry jarfile path = do
  18   Zip.catchZipError (Just `fmap` (Zip.withArchive [] jarfile $ Zip.fileContents [] path))
  19                     (\_ -> return Nothing)
  20
  21 -- | Read all entires from JAR file
  22 readAllJAR :: FilePath -> IO [Tree CPEntry]
  23 readAllJAR jarfile = do
  24     files <- Zip.withArchive [] jarfile $ Zip.fileNames []
  25     return $ mapF (NotLoadedJAR jarfile) (buildTree $ filter good files)
  26   where
  27     good file = ".class" `isSuffixOf` file
  28
  29 -- | Read one class from JAR file
  30 readFromJAR :: FilePath -> FilePath -> IO (Class Direct)
  31 readFromJAR jarfile path = do
  32   content <- Zip.withArchive [] jarfile $ Zip.fileContents [] path
  33   let bstr = B.pack content
  34   return $ classFile2Direct (decode bstr)
  35
  36 checkClassTree :: [Tree CPEntry] -> IO [Tree (FilePath, Class Direct)]
  37 checkClassTree forest = mapFMF check forest
  38   where
  39     check _ (NotLoaded path) = do
  40        cls <- parseClassFile path
  41        return (path, cls)
  42     check a (Loaded path cls) = return (a </> path, cls)
  43     check a (NotLoadedJAR jar path) = do
  44        cls <- readFromJAR jar (a </> path)
  45        return (a </> path, cls)
  46     check a (LoadedJAR _ cls) =
  47        return (a </> show (thisClass cls), cls)
  48
  49 zipJAR :: [Tree (FilePath, Class Direct)] -> Zip.Archive ()
  50 zipJAR forest = do
  51     mapFM go forest
  52     return ()
  53   where
  54     go (path, cls) = Zip.addFile path =<< Zip.sourceBuffer (B.unpack $ encodeClass cls)
  55