84 lines
2.5 KiB
Haskell
84 lines
2.5 KiB
Haskell
|
{-# LANGUAGE NamedFieldPuns #-}
|
||
|
|
module Main where
|
||
|
|
|
||
|
|
import SJW (Path(..))
|
||
|
|
import Control.Monad (foldM)
|
||
|
|
import System.Directory (createDirectoryIfMissing)
|
||
|
|
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 = "tests/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 = generateDAG 10000 10 (50, 100) >>= mapM_ writeFakeModule
|