This repository was archived by the owner on Sep 3, 2022. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 1
Expand file tree
/
Copy pathClassPath.hs
More file actions
125 lines (111 loc) · 4.27 KB
/
Copy pathClassPath.hs
File metadata and controls
125 lines (111 loc) · 4.27 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
module Java2js.Java.ClassPath
(module Java2js.Java.ClassPath.Types,
module Java2js.Java.ClassPath.Common,
appendPath, addDirectory, loadClass, addClassFile, mergeClassPath,
runClassPath, execClassPath,
getEntry,dumpTree
) where
import qualified Control.Monad.State as St
import Control.Monad.Trans (liftIO)
import System.FilePath.Glob hiding (glob)
import Data.String.Utils (split)
import Java2js.JVM.ClassFile
import Java2js.JVM.Converter
import Java2js.Java.ClassPath.Types
import Java2js.Java.ClassPath.Common
import Java2js.Java.JAR.Archive
dumpTree :: [Tree t] -> IO ()
dumpTree tree = dumpTree' "" tree
where
dumpTree' _ [] = return ()
dumpTree' indent (Directory p k:left) = do
putStrLn (indent ++ p)
dumpTree' ('\t':indent) k
dumpTree' indent left
return ()
dumpTree' indent (_:left) = dumpTree' indent left
-- | For given list of glob masks, return list of matching files
glob :: FilePath -> [FilePath] -> IO [FilePath]
glob dir patterns = do
(matches, _) <- globDir (map compile patterns) dir
return $ concat matches
-- | Append one file to ClassPath forest
appendPath :: FilePath -> [Tree CPEntry] -> [Tree CPEntry]
appendPath path forest = merge $ forest ++ (mapF NotLoaded $ buildTree [path])
-- | Add one directory to current ClassPath
addDirectory :: FilePath -> ClassPath ()
addDirectory dir = do
files <- liftIO $ glob dir ["*.class"]
cp <- St.get
let cp' = foldr appendPath cp files
St.put cp'
-- | Run ClassPath monad
runClassPath :: ClassPath a -> IO a
runClassPath m = St.evalStateT m []
-- | Run ClassPath monad and return resulting ClassPath
execClassPath :: ClassPath () -> IO [Tree CPEntry]
execClassPath m = St.execStateT m []
-- | Load one class in current ClassPath
loadClass :: String -> ClassPath ()
loadClass path = do
cp <- St.get
cp' <- liftIO $ mapM (load xs) cp
St.put cp'
where
xs = split "/" path
load :: [String] -> Tree CPEntry -> IO (Tree CPEntry)
load [] t = return t
load (p:ps) t@(Directory dir forest)
| p == dir = Directory dir `fmap` mapM (load ps) forest
| otherwise = return t
load [p] t@(File (NotLoaded f))
| (p ++ ".class") == f = do
cls <- parseClassFile (path ++ ".class")
return (File $ Loaded path cls)
| otherwise = return t
load [p] t@(File (NotLoadedJAR jarfile f))
| (p ++ ".class") == f = do
cls <- readFromJAR jarfile (path ++ ".class")
return (File $ LoadedJAR jarfile cls)
| otherwise = return t
load ps (File _) = fail $ "Found file when expecting directory! " ++ show ps
-- | Add given Class file to ClassPath
addClassFile :: FilePath -> ClassPath ()
addClassFile clsfile = do
cp <- St.get
St.put (File (NotLoaded clsfile):cp)
-- | Merge two classpath
mergeClassPath :: ClassPath a -> ClassPath b -> ClassPath ()
mergeClassPath a b = do
cp <- St.get
acp <- St.lift $ St.execStateT a cp
bcp <- St.lift $ St.execStateT b acp
St.put (merge $ cp ++ acp ++ bcp)
-- | Get one ClassPath entry
getEntry :: [Tree CPEntry] -> String -> IO (Maybe CPEntry)
getEntry cp path = get cp (split "/" path)
where
get :: [Tree CPEntry] -> [String] -> IO (Maybe CPEntry)
get _ [] = fail "Empty path for ClassPath.getEntry.get!"
get [] _ = return Nothing
get (Directory dir forest: es) (p:ps)
| dir == p = get forest ps
| otherwise = get es (p:ps)
get (File i@(NotLoaded f): es) [p]
| (p ++ ".class" == f) = do
cls <- parseClassFile (path ++ ".class")
return $ Just (Loaded path cls)
| otherwise = get es [p]
get (File i@(NotLoadedJAR jarfile r): es) [p]
| (p ++ ".class" == r) = do
cls <- readFromJAR jarfile (path ++ ".class")
return $ Just (LoadedJAR jarfile cls)
| otherwise = get es [p]
get (File i@(Loaded f c):es) [p]
| f == p = return (Just i)
| otherwise = get es [p]
get (File i@(LoadedJAR f c):es) [p]
| toString (thisClass c) == path = return (Just i)
| otherwise = get es [p]
get (_:es) p = get es p
-- get x y = fail $ "Unexpected arguments for ClassPath.getEntry.get: " ++ show x ++ ", " ++ show y