Java/ClassPath.hs

   1
   2 module Java.ClassPath
   3   (module Java.ClassPath.Types,
   4    module Java.ClassPath.Common,
   5    appendPath, addDirectory, loadClass,
   6    runClassPath, execClassPath,
   7    getEntry
   8   ) where
   9
  10 import qualified Control.Monad.State as St
  11 import Control.Monad.Trans (liftIO)
  12 import System.FilePath.Glob
  13 import Data.String.Utils (split)
  14
  15 import JVM.ClassFile
  16 import JVM.Converter
  17 import Java.ClassPath.Types
  18 import Java.ClassPath.Common
  19 import Java.JAR.Archive
  20
  21 -- | For given list of glob masks, return list of matching files
  22 glob :: FilePath -> [FilePath] -> IO [FilePath]
  23 glob dir patterns = do
  24   (matches, _) <- globDir (map compile patterns) dir
  25   return $ concat matches
  26
  27 appendPath :: FilePath -> [Tree CPEntry] -> [Tree CPEntry]
  28 appendPath path forest = merge $ forest ++ (mapF NotLoaded $ buildTree [path])
  29
  30 addDirectory :: FilePath -> ClassPath ()
  31 addDirectory dir = do
  32   files <- liftIO $ glob dir ["*.class"]
  33   cp <- St.get
  34   let cp' = foldr appendPath cp files
  35   St.put cp'
  36
  37 runClassPath :: ClassPath a -> IO a
  38 runClassPath m = St.evalStateT m []
  39
  40 execClassPath :: ClassPath () -> IO [Tree CPEntry]
  41 execClassPath m = St.execStateT m []
  42
  43 loadClass :: String -> ClassPath ()
  44 loadClass path = do
  45     cp <- St.get
  46     cp' <- liftIO $ mapM (load xs) cp
  47     St.put cp'
  48   where
  49     xs = split "/" path
  50
  51     load :: [String] -> Tree CPEntry -> IO (Tree CPEntry)
  52     load [] t = return t
  53     load (p:ps) t@(Directory dir forest)
  54       | p == dir  = Directory dir `fmap` mapM (load ps) forest
  55       | otherwise = return t
  56     load [p] t@(File (NotLoaded f))
  57       | (p ++ ".class") == f = do
  58                                cls <- parseClassFile (path ++ ".class")
  59                                return (File $ Loaded path cls)
  60       | otherwise = return t
  61     load [p] t@(File (NotLoadedJAR jarfile f))
  62       | (p ++ ".class") == f = do
  63                                cls <- readFromJAR jarfile (path ++ ".class")
  64                                return (File $ LoadedJAR jarfile cls)
  65       | otherwise = return t
  66     load ps (File _) = fail $ "Found file when expecting directory! " ++ show ps
  67
  68 getEntry :: [Tree CPEntry] -> String -> IO (Maybe CPEntry)
  69 getEntry cp path = get cp (split "/" path)
  70   where
  71     get :: [Tree CPEntry] -> [String] -> IO (Maybe CPEntry)
  72     get _ [] = fail "Empty path for ClassPath.getEntry.get!"
  73     get [] _ = return Nothing
  74     get (Directory dir forest: es) (p:ps)
  75       | dir == p  = get forest ps
  76       | otherwise = get es (p:ps)
  77     get (File i@(NotLoaded f): es) [p]
  78       | (p ++ ".class" == f) = do
  79                                cls <- parseClassFile (path ++ ".class")
  80                                return $ Just (Loaded path cls)
  81       | otherwise = get es [p]
  82     get (File i@(NotLoadedJAR jarfile r): es) [p]
  83       | (p ++ ".class" == r) = do
  84                                cls <- readFromJAR jarfile (path ++ ".class")
  85                                return $ Just (LoadedJAR jarfile cls)
  86       | otherwise = get es [p]
  87     get (File i@(Loaded f c):es) [p]
  88       | f == p = return (Just i)
  89       | otherwise = get es [p]
  90     get (File i@(LoadedJAR f c):es) [p]
  91       | toString (thisClass c) == path = return (Just i)
  92       | otherwise = get es [p]
  93     get x y = fail $ "Unexpected arguments for ClassPath.getEntry.get: " ++ show x ++ ", " ++ show y
  94