Skip to content
Newer
Older
100644 175 lines (149 sloc) 5.54 KB
fed1050 @dmpots Rename benchmark finding file
authored
1 module FindBench(findLocalBenchmarks) where
a179ae1 @dmpots Generate the benchmarks list automatically
authored
2 --module Main where
3
4 import Control.Exception
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
5 import Control.Monad (filterM, when)
4891ee2 @dmpots Added submodule for benchmarks
authored
6 import Data.List
7 import System.Directory
a179ae1 @dmpots Generate the benchmarks list automatically
authored
8 import System.FilePath
9 import System.IO
10
11 {-
12 -- for standalone testing
13 main = do
14 findLocalBenchmarks "benchmarks"
15 -}
16
17 benchmarksModule = ["Fibon", "Benchmarks"]
18 benchmarksInstanceModule = "Fibon.Instance"
19
20 findLocalBenchmarks :: FilePath -> IO ()
21 findLocalBenchmarks baseDir = do
22 let searchPath = join ([pathSeparator]) (baseDir : benchmarksModule)
23 putStr $ "Looking for benchmarks in "++searchPath
24 groups <- bmGroups searchPath
25 bms <- bmInstances searchPath groups
26 let allGroups = sort groups
27 allBms = (sort . concat) bms
28 qualifiedBms =
29 concat $ zipWith (\g bs -> map ((,)g) (sort bs)) allGroups bms
30 outFile = searchPath ++ ".hs"
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
31 when (null allGroups) printNoBenchmarksWarning
1be9a50 @dmpots Print out the correct number of benchmarks found
authored
32 putStrLn $ "... found ("++ (show.length$ allBms)++")"
ae70834 @dmpots Stop using template haskell for config finder
authored
33 putStrLn $ " writing benchmark manifest to "++outFile
a179ae1 @dmpots Generate the benchmarks list automatically
authored
34 h <- openFile outFile WriteMode
35 hPutStrLn h moduleHeader
36 hPutStrLn h $ moduleImports (join "." benchmarksModule) qualifiedBms
37 hPutStrLn h ""
38 hPutStrLn h $ benchDataDecl allBms
39 hPutStrLn h ""
40 hPutStrLn h $ groupDataDecl allGroups
41 hPutStrLn h ""
42 hPutStrLn h $ allBenchmarksDecl allBms
43 hPutStrLn h ""
44 hPutStrLn h $ benchGroupDecl qualifiedBms
45 hPutStrLn h ""
46 hPutStrLn h $ benchInstanceDecl qualifiedBms
d8bef2f @dmpots Remove localPath field from BenchmarkInstance
authored
47 hPutStrLn h ""
48 hPutStrLn h $ benchPathDecl qualifiedBms
a179ae1 @dmpots Generate the benchmarks list automatically
authored
49 hClose h
50
51 bmGroups :: FilePath -> IO [FilePath]
52 bmGroups baseDir = do
53 dirs <- try (getDirectoryContents baseDir) :: IO (Either IOError [FilePath])
54 case dirs of
55 Left _ -> return []
e667759 @dmpots Fix benchmark finding to respect directory path
authored
56 Right ds -> removeBadEntries baseDir ds
a179ae1 @dmpots Generate the benchmarks list automatically
authored
57
58 bmInstances :: FilePath -> [FilePath] -> IO [[String]]
59 bmInstances baseDir groups = do
e667759 @dmpots Fix benchmark finding to respect directory path
authored
60 let paths = map (baseDir </>) groups
a179ae1 @dmpots Generate the benchmarks list automatically
authored
61 bms <- mapM getDirectoryContents paths
e667759 @dmpots Fix benchmark finding to respect directory path
authored
62 mapM (\(p, bm) -> removeBadEntries p bm) (zip paths bms)
4891ee2 @dmpots Added submodule for benchmarks
authored
63
64 removeDotFiles :: [FilePath] -> [FilePath]
65 removeDotFiles = filter (\d -> not ("." `isPrefixOf` d))
a179ae1 @dmpots Generate the benchmarks list automatically
authored
66
e667759 @dmpots Fix benchmark finding to respect directory path
authored
67 removeBadEntries :: FilePath -> [FilePath] -> IO [FilePath]
68 removeBadEntries baseDir dirs = do
69 let paths = map (baseDir </>) dirs
70 noFiles <- filterM (\d -> doesDirectoryExist (baseDir </> d)) dirs
d8658ac @dmpots Don't include benchmark directories starting with _
authored
71 let noUnderscores = filter (\d -> not ("_" `isPrefixOf` d)) noFiles
72 return (removeDotFiles noUnderscores)
a179ae1 @dmpots Generate the benchmarks list automatically
authored
73
74 moduleHeader :: String
75 moduleHeader = join "\n" [
76 "module "++modName++" (",
77 " FibonBenchmark(..)",
78 " , FibonGroup(..)",
79 " , allBenchmarks",
80 " , benchGroup",
81 " , benchInstance",
d8bef2f @dmpots Remove localPath field from BenchmarkInstance
authored
82 " , benchPath",
a179ae1 @dmpots Generate the benchmarks list automatically
authored
83 ")",
84 "where",
85 "import Fibon.InputSize",
d8bef2f @dmpots Remove localPath field from BenchmarkInstance
authored
86 "import Fibon.BenchmarkInstance",
87 "import System.FilePath"
a179ae1 @dmpots Generate the benchmarks list automatically
authored
88 ]
89 where
90 modName = join "." benchmarksModule
91
92 moduleImports :: String -> [(String, String)] -> String
93 moduleImports baseMod bms = join "\n" imports
94 where
95 imports = map importStmt bms
96 importStmt (g,bm) =
97 "import qualified "
98 ++baseMod++"."++g++"."++bm++"."++benchmarksInstanceModule
99 ++" as "++(importAs g bm)
100
101 importAs :: String -> String -> String
102 importAs _grp modu = modu ++ "_bm"
103
104 groupName :: String -> String
bbb1c8e @dmpots Added command line option parsing
authored
105 groupName g = g
a179ae1 @dmpots Generate the benchmarks list automatically
authored
106
107 benchDataDecl :: [String] -> String
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
108 benchDataDecl bms = "data FibonBenchmark = " ++ datas bms ++ derivings
109 where derivings = "\n deriving(Read, Show, Eq, Ord, Enum)"
110 datas [] = "NoBenchmarksFound"
111 datas bms = "\n " ++ (join ("\n | ") bms)
a179ae1 @dmpots Generate the benchmarks list automatically
authored
112
113 groupDataDecl :: [String] -> String
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
114 groupDataDecl grps = "data FibonGroup = " ++ datas grps ++ derivings
115 where derivings = "\n deriving(Read, Show, Eq, Ord, Enum)"
116 datas [] = "NoGroupsFound"
117 datas grps = "\n "++ (join ("\n | ") (map groupName grps))
a179ae1 @dmpots Generate the benchmarks list automatically
authored
118
119 allBenchmarksDecl :: [String] -> String
120 allBenchmarksDecl bms =
121 "allBenchmarks :: [FibonBenchmark]\n"++
122 "allBenchmarks = [\n "++
123 (join ("\n , ") bms) ++
124 "\n ]"
125
126 benchGroupDecl :: [(String, String)] -> String
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
127 benchGroupDecl [] = benchGroupTypeDecl ++ "benchGroup = "++ emptyError
128 benchGroupDecl qBms = benchGroupTypeDecl ++ (join ("\n") $ map defn qBms)
a179ae1 @dmpots Generate the benchmarks list automatically
authored
129 where
130 defn (g,bm) = "benchGroup " ++ bm ++ " = " ++ (groupName g)
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
131
132 benchGroupTypeDecl :: String
133 benchGroupTypeDecl = "benchGroup :: FibonBenchmark -> FibonGroup\n"
134
a179ae1 @dmpots Generate the benchmarks list automatically
authored
135 benchInstanceDecl :: [(String, String)] -> String
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
136 benchInstanceDecl [] = benchInstanceTypeDecl ++ "benchInstance = "++ emptyError
137 benchInstanceDecl qBms = benchInstanceTypeDecl ++ (join ("\n") $ map defn qBms)
a179ae1 @dmpots Generate the benchmarks list automatically
authored
138 where
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
139 defn (g,bm) =
140 "benchInstance " ++ bm ++ " = " ++ (importAs g bm) ++ ".mkInstance"
a179ae1 @dmpots Generate the benchmarks list automatically
authored
141
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
142 benchInstanceTypeDecl :: String
143 benchInstanceTypeDecl =
144 "benchInstance :: FibonBenchmark -> InputSize -> BenchmarkInstance\n"
d8bef2f @dmpots Remove localPath field from BenchmarkInstance
authored
145
146 benchPathDecl :: [(String, String)] -> String
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
147 benchPathDecl [] = benchPathTypeDecl ++ "benchPath = " ++ emptyError
148 benchPathDecl qBms = benchPathTypeDecl ++ (join ("\n") $ map defn qBms)
d8bef2f @dmpots Remove localPath field from BenchmarkInstance
authored
149 where
150 defn (g,bm) = "benchPath " ++ bm ++ " = " ++ s g ++ " </> " ++ s bm
151 s x = "\"" ++ x ++"\""
152
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
153 benchPathTypeDecl :: String
154 benchPathTypeDecl = "benchPath :: FibonBenchmark -> FilePath\n"
155
a179ae1 @dmpots Generate the benchmarks list automatically
authored
156 join :: String -> [String] -> String
157 join s ss = concat (intersperse s ss)
158
0af7274 @dmpots Allow fibon to be built without any benchmarks
authored
159 emptyError :: String
160 emptyError = "error \"No benchmarks found. Need to re-run cabal config step\""
161
162 printNoBenchmarksWarning :: IO ()
163 printNoBenchmarksWarning = do
164 putStrLn "\n"
165 putStrLn banner
166 putStrLn $cap("! No benchmarks found.")
167 putStrLn $cap("! You will not be able to run collect results with fibon-run")
168 putStrLn banner
169 putStrLn ""
170 where
171 banner = line++"WARNING"++line
172 line = take 30 (repeat '-')
173 cap s = s ++ take ((length banner) - (length s) - 1) (repeat ' ') ++ "!"
174
Something went wrong with that request. Please try again.