Java/JAR.hs

   1
   2 module Java.JAR
   3   (readManifest,
   4    readJAR,
   5    readMainClass,
   6    addJAR
   7   ) where
   8
   9 import Control.Monad.Trans (liftIO)
  10 import qualified Control.Monad.State as St
  11 import Data.List
  12 import qualified Codec.Archive.LibZip as Zip
  13
  14 import Java.ClassPath
  15 import Java.JAR.Archive
  16 import Java.META
  17
  18 readManifest :: Zip.Archive (Maybe Manifest)
  19 readManifest = do
  20   let manifestPath = "META-INF/MANIFEST.MF"
  21   files <- Zip.fileNames []
  22   if manifestPath `elem` files
  23     then do
  24          content <- Zip.fileContents [] manifestPath
  25          case parseMeta content of
  26            Left e -> fail $ show e
  27            Right meta -> return $ Just (loadSpec meta)
  28     else return Nothing
  29
  30 readOne :: FilePath -> String -> Zip.Archive [Tree CPEntry]
  31 readOne jarfile str = do
  32     files <- Zip.fileNames []
  33     return $ mapF (NotLoadedJAR jarfile) (buildTree $ filter good files)
  34   where
  35     good name = (str `isPrefixOf` name) && (".class" `isSuffixOf` name)
  36
  37 -- | Read MainClass Entry of a MANIFEST.MF file
  38 readMainClass :: FilePath -> IO (Maybe String)
  39 readMainClass jarfile = do
  40   Zip.withArchive [] jarfile $ do
  41     m <- readManifest
  42     case m of
  43       Nothing -> return Nothing
  44       Just mf -> return $ mainClass mf
  45
  46 -- | Read entries from JAR file, using MANIFEST.MF if it exists.
  47 readJAR :: FilePath -> IO [Tree CPEntry]
  48 readJAR jarfile = do
  49   r <- Zip.withArchive [] jarfile $ do
  50          m <- readManifest
  51          case m of
  52            Nothing -> return Nothing
  53            Just mf -> do
  54                       trees <- mapM (readOne jarfile) (map meName $ manifestEntries mf)
  55                       let forest = merge (concat trees)
  56                       return (Just forest)
  57   case r of
  58     Nothing -> readAllJAR jarfile
  59     Just [] -> readAllJAR jarfile
  60     Just f  -> return f
  61
  62 -- | Add given JAR file to ClassPath
  63 addJAR :: FilePath -> ClassPath ()
  64 addJAR jarfile = do
  65   classes <- liftIO $ readJAR jarfile
  66   cp <- St.get
  67   let cp' = merge $ cp ++ classes
  68   St.put cp'
  69