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 hiding (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 -- | Append one file to ClassPath forest
  28 appendPath :: FilePath -> [Tree CPEntry] -> [Tree CPEntry]
  29 appendPath path forest = merge $ forest ++ (mapF NotLoaded $ buildTree [path])
  30
  31 -- | Add one directory to current ClassPath
  32 addDirectory :: FilePath -> ClassPath ()
  33 addDirectory dir = do
  34   files <- liftIO $ glob dir ["*.class"]
  35   cp <- St.get
  36   let cp' = foldr appendPath cp files
  37   St.put cp'
  38
  39 -- | Run ClassPath monad
  40 runClassPath :: ClassPath a -> IO a
  41 runClassPath m = St.evalStateT m []
  42
  43 -- | Run ClassPath monad and return resulting ClassPath
  44 execClassPath :: ClassPath () -> IO [Tree CPEntry]
  45 execClassPath m = St.execStateT m []
  46
  47 -- | Load one class in current ClassPath
  48 loadClass :: String -> ClassPath ()
  49 loadClass path = do
  50     cp <- St.get
  51     cp' <- liftIO $ mapM (load xs) cp
  52     St.put cp'
  53   where
  54     xs = split "/" path
  55
  56     load :: [String] -> Tree CPEntry -> IO (Tree CPEntry)
  57     load [] t = return t
  58     load (p:ps) t@(Directory dir forest)
  59       | p == dir  = Directory dir `fmap` mapM (load ps) forest
  60       | otherwise = return t
  61     load [p] t@(File (NotLoaded f))
  62       | (p ++ ".class") == f = do
  63                                cls <- parseClassFile (path ++ ".class")
  64                                return (File $ Loaded path cls)
  65       | otherwise = return t
  66     load [p] t@(File (NotLoadedJAR jarfile f))
  67       | (p ++ ".class") == f = do
  68                                cls <- readFromJAR jarfile (path ++ ".class")
  69                                return (File $ LoadedJAR jarfile cls)
  70       | otherwise = return t
  71     load ps (File _) = fail $ "Found file when expecting directory! " ++ show ps
  72
  73 -- | Get one ClassPath entry
  74 getEntry :: [Tree CPEntry] -> String -> IO (Maybe CPEntry)
  75 getEntry cp path = get cp (split "/" path)
  76   where
  77     get :: [Tree CPEntry] -> [String] -> IO (Maybe CPEntry)
  78     get _ [] = fail "Empty path for ClassPath.getEntry.get!"
  79     get [] _ = return Nothing
  80     get (Directory dir forest: es) (p:ps)
  81       | dir == p  = get forest ps
  82       | otherwise = get es (p:ps)
  83     get (File i@(NotLoaded f): es) [p]
  84       | (p ++ ".class" == f) = do
  85                                cls <- parseClassFile (path ++ ".class")
  86                                return $ Just (Loaded path cls)
  87       | otherwise = get es [p]
  88     get (File i@(NotLoadedJAR jarfile r): es) [p]
  89       | (p ++ ".class" == r) = do
  90                                cls <- readFromJAR jarfile (path ++ ".class")
  91                                return $ Just (LoadedJAR jarfile cls)
  92       | otherwise = get es [p]
  93     get (File i@(Loaded f c):es) [p]
  94       | f == p = return (Just i)
  95       | otherwise = get es [p]
  96     get (File i@(LoadedJAR f c):es) [p]
  97       | toString (thisClass c) == path = return (Just i)
  98       | otherwise = get es [p]
  99     get x y = fail $ "Unexpected arguments for ClassPath.getEntry.get: " ++ show x ++ ", " ++ show y
 100