SJW/benchmark/Main.hs

98 lines
3.1 KiB
Haskell
Raw Normal View History

2020-12-08 12:06:19 +01:00
{-# LANGUAGE NamedFieldPuns #-}
module Main where
import SJW (Path(..), compile, source, sourceCode)
import Control.Monad (foldM)
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
import System.FilePath ((</>), (<.>))
import System.Random (randomRIO)
import Text.Printf (printf)
data FakeModule = FakeModule {
name :: Path
, dependencies :: [Path]
} deriving Show
type DAG = [FakeModule]
moduleNames :: [String]
moduleNames = (:[]) <$> ['A'..'Z']
emptyModule :: Path -> FakeModule
emptyModule name = FakeModule {name, dependencies = []}
addDependency :: Path -> FakeModule -> FakeModule
addDependency path fakeModule = fakeModule {
dependencies = path : (dependencies fakeModule)
}
destDir :: FilePath
destDir = "/tmp/SJW-benchmark/giant"
generateCode :: FakeModule -> String
generateCode (FakeModule {dependencies}) = unlines $
(printf "import %s;" . show <$> dependencies)
++ [
""
, "return {"
, " s: 'truc'"
, "};"
]
combinations :: [a] -> [[a]]
combinations l = ((:[]) <$> l) ++ concat [(:m) <$> l | m <- combinations l]
edit :: Int -> (a -> a) -> [a] -> [a]
edit 0 _ l = l
edit 1 _ [] = []
edit 1 f (x:xs) = (f x):xs
edit n f l =
let (beginning, end) = splitAt half l in
edit m f beginning ++ edit (n - m) f end
where
half = length l `div` 2
m = n `div` 2
generateDAG :: Int -> Int -> (Int, Int) -> IO DAG
generateDAG size maxTargets generationSize =
let paths = ["Main"] : (take size $ combinations moduleNames) in
addEdges [] $ emptyModule . Path <$> paths
where
addEdges ready nodes
| length nodes < 2 = return $ nodes ++ ready
| otherwise = do
(targets, chosen) <- generation nodes
addEdges (chosen ++ ready) =<< foldM edgesTo targets chosen
generation nodes = do
genSize <- randomRIO generationSize
return $ splitAt (max 1 (length nodes - genSize)) nodes
edgesTo [mainModule] (FakeModule {name}) =
return [addDependency name mainModule]
edgesTo targets (FakeModule {name}) = do
nTargets <- randomRIO (1, maxTargets)
(intact, nextGen) <- generation targets
return (intact ++ edit nTargets (addDependency name) nextGen)
writeFakeModule :: FakeModule -> IO ()
writeFakeModule fakeModule@(FakeModule {name = Path components}) =
let (parents, fileName) = splitAt (length components - 1) components in
let directory = foldl (</>) destDir parents in do
createDirectoryIfMissing True directory
writeFile (directory </> head fileName <.> "js") $ generateCode fakeModule
main :: IO ()
main = do
directoryExists <- doesDirectoryExist destDir
if not directoryExists
then do
createDirectoryIfMissing True destDir
generateDAG 10000 10 (50, 100) >>= mapM_ writeFakeModule
else return ()
start <- getCurrentTime
maybe (return ()) (\_ -> return ()) =<< sourceCode =<< compile (source [destDir])
end <- getCurrentTime
mapM_ putStrLn [
"Compiled 10k modules in " ++ show (diffUTCTime end start)
, "Left the fake project in " ++ destDir ++ " if you want to poke around"
]