{-# 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" ]