JAR/Archive.hs

   1
   2 module JAR.Archive where
   3
   4 import Control.Monad.Trans
   5 import qualified Control.Monad.State as St
   6 import qualified Codec.Archive.LibZip as Zip
   7 import Data.Binary
   8 import Data.String.Utils (split)
   9 import qualified Data.ByteString.Lazy as B
  10
  11 import Java.ClassPath
  12 import JVM.ClassFile
  13 import JVM.Converter
  14
  15 readJAR :: FilePath -> IO [Tree CPEntry]
  16 readJAR jarfile = do
  17   files <- Zip.withArchive [] jarfile $ Zip.fileNames []
  18   return $ mapF (NotLoadedJAR jarfile) (buildTree files)
  19
  20 readFromJAR :: FilePath -> FilePath -> IO (Class Direct)
  21 readFromJAR jarfile path = do
  22   content <- Zip.withArchive [] jarfile $ Zip.fileContents [] path
  23   let bstr = B.pack content
  24   return $ classFile2Direct (decode bstr)
  25
  26 addJAR :: FilePath -> ClassPath ()
  27 addJAR jarfile = do
  28   classes <- liftIO $ readJAR jarfile
  29   cp <- St.get
  30   let cp' = merge $ cp ++ classes
  31   St.put cp'
  32
  33 loadClass :: String -> ClassPath ()
  34 loadClass path = do
  35     cp <- St.get
  36     cp' <- liftIO $ mapM (load xs) cp
  37     St.put cp'
  38   where
  39     xs = split "/" path
  40
  41     load :: [String] -> Tree CPEntry -> IO (Tree CPEntry)
  42     load [] t = return t
  43     load (p:ps) t@(Directory dir forest)
  44       | p == dir  = Directory dir `fmap` mapM (load ps) forest
  45       | otherwise = return t
  46     load [p] t@(File (NotLoaded f))
  47       | (p ++ ".class") == f = do
  48                                cls <- parseClassFile (path ++ ".class")
  49                                return (File $ Loaded path cls)
  50       | otherwise = return t
  51     load [p] t@(File (NotLoadedJAR jarfile f))
  52       | (p ++ ".class") == f = do
  53                                cls <- readFromJAR jarfile (path ++ ".class")
  54                                return (File $ LoadedJAR jarfile cls)
  55       | otherwise = return t
  56     load ps (File _) = fail $ "Found file when expecting directory! " ++ show ps
  57