3 (module Java.ClassPath.Types,
4 module Java.ClassPath.Common,
5 appendPath, addDirectory, loadClass,
6 runClassPath, execClassPath,
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)
17 import Java.ClassPath.Types
18 import Java.ClassPath.Common
19 import Java.JAR.Archive
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
27 -- | Append one file to ClassPath forest
28 appendPath :: FilePath -> [Tree CPEntry] -> [Tree CPEntry]
29 appendPath path forest = merge $ forest ++ (mapF NotLoaded $ buildTree [path])
31 -- | Add one directory to current ClassPath
32 addDirectory :: FilePath -> ClassPath ()
34 files <- liftIO $ glob dir ["*.class"]
36 let cp' = foldr appendPath cp files
39 -- | Run ClassPath monad
40 runClassPath :: ClassPath a -> IO a
41 runClassPath m = St.evalStateT m []
43 -- | Run ClassPath monad and return resulting ClassPath
44 execClassPath :: ClassPath () -> IO [Tree CPEntry]
45 execClassPath m = St.execStateT m []
47 -- | Load one class in current ClassPath
48 loadClass :: String -> ClassPath ()
51 cp' <- liftIO $ mapM (load xs) cp
56 load :: [String] -> Tree CPEntry -> IO (Tree CPEntry)
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
73 -- | Get one ClassPath entry
74 getEntry :: [Tree CPEntry] -> String -> IO (Maybe CPEntry)
75 getEntry cp path = get cp (split "/" path)
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