124 lines
4.0 KiB
Haskell
124 lines
4.0 KiB
Haskell
--- SJW -- Clean Javascript modules for front-end development
|
|
--- Copyright © 2022 Tissevert <tissevert+devel@marvid.fr>
|
|
---
|
|
--- This file is part of SJW.
|
|
---
|
|
--- SJW is free software: you can redistribute it and/or modify it under the
|
|
--- terms of the GNU General Public License as published by the Free Software
|
|
--- Foundation, either version 3 of the License, or (at your option) any later
|
|
--- version.
|
|
---
|
|
--- SJW is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
--- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
|
--- FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
|
|
--- details.
|
|
---
|
|
--- You should have received a copy of the GNU General Public License along
|
|
--- with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Main where
|
|
|
|
import SJW (Path(..), compile, source)
|
|
import Control.Monad (foldM)
|
|
import Data.Time.Clock (diffUTCTime, getCurrentTime)
|
|
import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
|
|
import System.Exit (die)
|
|
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
|
|
compile (source [destDir]) >>= either fails (succeeds start)
|
|
where
|
|
fails errorMsg = die $
|
|
printf
|
|
"%s\nThe benchmark crashed and failed to compile the modules generated in %s"
|
|
errorMsg
|
|
destDir
|
|
succeeds start _ = do
|
|
end <- getCurrentTime
|
|
mapM_ putStrLn [
|
|
"Compiled 10k modules in " ++ show (diffUTCTime end start)
|
|
, "Left the fake project in " ++ destDir ++ " if you want to poke around"
|
|
]
|