98 lines
3.1 KiB
Haskell
98 lines
3.1 KiB
Haskell
|
{-# 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"
|
||
|
|
]
|